
!  This is a test program for FM 1.3, a multiple-precision arithmetic package.

!  All of the FM (floating-point real) and ZM (floating-point complex) routines are tested.
!  Precision is set to 50 significant digits and the results are checked to that accuracy.
!  A few constants are computed with 20,000 significant digits to test the routines that
!  use special algorithms for very high precision.
!  All of the IM (integer) routines are tested, with exact results required to pass the tests.
!  All of the USE FMZM derived type interface routines are tested in the same manner as those
!  described above.

!  If all tests are completed successfully, this line is printed:

!  3250 cases tested.  No errors were found.

      MODULE TEST_VARS

      USE FMVALS
      USE FMZM

!             Declare the derived type variables of type (FM), (IM), and (ZM).
!             These are in the form that would be found in a user program.

      TYPE (FM), SAVE ::  M_A, M_B, M_C, M_D, MFM1, MFM2, MFM3, MFM4, MFM5, MFM6, MSMALL,  &
                          MFMV1(3),  MFMV2(3),  MFMV4(3),  MFMV3(2),                       &
                          MFMA(3,3), MFMB(3,3), MFMC(3,3), MFMD(2,2), MFME(3,2), MFMF(2,3)

!             These are the integer multiple precision variables.

      TYPE (IM), SAVE :: M_J, M_K, M_L,  MIM1,  MIM2,  MIM3, MIM4, MIM5
      TYPE (IM), SAVE, DIMENSION(3)   :: MIMV1, MIMV2, MIMV4
      TYPE (IM), SAVE, DIMENSION(2)   :: MIMV3
      TYPE (IM), SAVE, DIMENSION(2,2) :: MIMA,  MIMB,  MIMC
      TYPE (IM), SAVE, DIMENSION(3,2) :: MIMD
      TYPE (IM), SAVE, DIMENSION(2,3) :: MIME
      TYPE (IM), SAVE, DIMENSION(3,3) :: MIMA2, MIMB2, MIMC2

!             These are the complex multiple precision variables.

      TYPE (ZM), SAVE :: M_X, M_Y, M_Z, MZM1, MZM2, MZM3, MZM4, MZM5,              &
                         MZMV1(3),   MZMV2(3),   MZMV4(3),   MZMV3(2),  MZMV5(4),  &
                         MZMA(2,3),  MZMB(3,4),  MZMC(2,4),  MZMD(3,2),            &
                         MZMA2(3,3), MZMB2(3,3), MZMC2(3,3), MZMA3(3,3)

!             Declare and initialize some other multiple precision variables.
!             These are in the internal form used in the basic arithmetic routines.

      INTEGER :: MA, MB, MC, MD, ME, MP1, MP2, MP3, MP4, MP5, MLNSV2, MLNSV3, MLNSV5, MLNSV7
      DATA MA, MB, MC, MD, ME, MP1, MP2, MP3, MP4, MP5, MLNSV2, MLNSV3, MLNSV5, MLNSV7 / 14 * -2 /
      INTEGER :: ZA(2), ZB(2), ZC(2), ZD(2), ZE(2), ZP1(2), ZP2(2), ZP3(2), ZP4(2), ZP5(2)
      DATA ZA, ZB, ZC, ZD, ZE, ZP1, ZP2, ZP3, ZP4, ZP5 / 20 * -2 /

!             These are the variables that are not multiple precision.

      INTEGER, SAVE :: J1, J2, J3, J4, J5, JV(3), JV2(3,3)
      REAL, SAVE :: R1, R2, R3, R4, R5, RSMALL, RV(3), RV2(3,3)
      DOUBLE PRECISION, SAVE :: D1, D2, D3, D4, D5, DSMALL, DV(3), DV2(3,3)
      COMPLEX, SAVE :: C1, C2, C3, C4, C5, CV(3), CV2(3,3)
      COMPLEX (KIND(0.0D0)), SAVE :: CD1, CD2, CD3, CD4, CDV(3), CDV2(3,3)

      CHARACTER(80), SAVE :: ST1, ST2, STRING, STV(3), STV2(3,3)
      CHARACTER(160), SAVE :: STZ1, STZ2
      CHARACTER, SAVE :: LINE(10), LINE2(80), LINE3(160)
      INTEGER, SAVE :: I, IREM, J, JERR, JEXP, K, KLOG, L1, L2, KST, KWSAVE,  &
                       NCASE, NDGSAV, NERROR, NSTACK(49), SEED(7)
      REAL, SAVE :: TIME1, TIME2
      REAL (KIND(1.0D0)) :: MBSAVE
      LOGICAL, EXTERNAL :: FMCOMP, FMCOMPARE, FPCOMP, FPCOMPARE,  &
                           IMCOMP, IMCOMPARE, IPCOMP, IPCOMPARE

      END MODULE TEST_VARS

      MODULE TEST_A
      USE TEST_VARS

      INTERFACE POWER
         MODULE PROCEDURE POWER_FM
         MODULE PROCEDURE POWER_IM
         MODULE PROCEDURE POWER_ZM
      END INTERFACE

      INTERFACE MATRIX_PRODUCT
         MODULE PROCEDURE MATRIX_PRODUCT_FM
         MODULE PROCEDURE MATRIX_PRODUCT_IM
         MODULE PROCEDURE MATRIX_PRODUCT_ZM
      END INTERFACE

      INTERFACE MATRIX_SQUARE
         MODULE PROCEDURE MATRIX_SQUARE_FM
         MODULE PROCEDURE MATRIX_SQUARE_IM
         MODULE PROCEDURE MATRIX_SQUARE_ZM
      END INTERFACE

      CONTAINS

      SUBROUTINE TEST1

!  Input and output testing.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing input and output routines.')")

!             NCASE is the number of the case being tested.

      NCASE = 1
      CALL FMST2M('123',MA)
      CALL FMI2M(123,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-48,ME)
      CALL FMEQ(ME,MB)

!             Use the .NOT. because FMCOMPARE returns FALSE for special cases like MD = UNKNOWN,
!             and these should be treated as errors for these tests.

      IF (.NOT.FMCOMPARE(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMST2M',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 2
      ST1 = '1.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMI2M(131,MB)
      CALL FMI2M(97,MC)
      CALL FMDIV(MB,MC,ME)
      CALL FMEQ(ME,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMPARE(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMST2M',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 3
      ST1 = '1.3505154639175257731958762886597938144329896907216495E-2'
      CALL FMST2M(ST1,MA)
      CALL FMI2M(131,MB)
      CALL FMI2M(9700,MC)
      CALL FMDIV(MB,MC,ME)
      CALL FMEQ(ME,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-52',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMST2M',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 4
      ST1 = '1.3505154639175257731958762886597938144329896907216495E-2'
      CALL FMST2M(ST1,MA)
      CALL FMFORM('F40.30',MA,ST2)
      CALL FMST2M(ST2,MA)
      ST1 = '         .013505154639175257731958762887'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('0',MB)
      IF ((.NOT.FMCOMP(MD,'LE',MB)) .OR. ST1 /= ST2) THEN
          CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 5
      ST1 = '1.3505154639175257731958762886597938144329896907216495E+16'
      CALL FMST2M(ST1,MA)
      CALL FMFORM('F53.33',MA,ST2)
      CALL FMST2M(ST2,MA)
      ST1 = '13505154639175257.731958762886597938144329896907216'
      CALL FMST2M(ST1,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 6
      ST1 = '1.3505154639175257731958762886597938144329896907216495E+16'
      CALL FMST2M(ST1,MA)
      CALL FMFORM('I24',MA,ST2)
      CALL FMST2M(ST2,MA)
      ST1 = '13505154639175258'
      CALL FMST2M(ST1,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 7
      ST1 ='-1.3505154639175257731958762886597938144329896907216495E+16'
      CALL FMST2M(ST1,MA)
      CALL FMFORM('E55.49',MA,ST2)
      CALL FMST2M(ST2,MA)
      ST1 = '-1.350515463917525773195876288659793814432989690722D16'
      CALL FMST2M(ST1,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 8
      ST1 ='-1.3505154639175257731958762886597938144329896907216495E+16'
      CALL FMST2M(ST1,MA)
      CALL FMFORM('ES54.45',MA,ST2)
      CALL FMST2M(ST2,MA)
      ST1 = '-1.350515463917525773195876288659793814432989691M+16'
      CALL FMST2M(ST1,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 9
      ST1 ='-1.3505154639175257731958762886597938144329896907216495E+16'
      CALL FMST2M(ST1,MA)
      CALL FMFORM('1PE54.45',MA,ST2)
      CALL FMST2M(ST2,MA)
      ST1 = '-1.350515463917525773195876288659793814432989691M+16'
      CALL FMST2M(ST1,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      CALL FM_SETVAR(' MBASE = 10000 ')
      CALL FM_SETVAR(' NDIG = 7 ')
      CALL FMSETVAR(' KROUND = 1 ')

      NCASE = 10
      STZ1 = '0.123456789012345678901234567849999999999999999999999999999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 11
      STZ1 = '0.12345678901234567890123456785'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 12
      STZ1 = '0.12345678901234567890123456785'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 13
      STZ1 = '0.12345678901234567890123456775'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 14
      STZ1 = '0.123456789012345678901234567850000000000000000000000000000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345679'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = 2 ')

      NCASE = 15
      STZ1 = '0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 16
      STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 17
      STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = -1 ')

      NCASE = 18
      STZ1 = '0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 19
      STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 20
      STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = 0 ')

      NCASE = 21
      STZ1 = '0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 22
      STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 23
      STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF



      CALL FMSETVAR(' KROUND = 1 ')

      NCASE = 24
      STZ1 = '-0.123456789012345678901234567849999999999999999999999999999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 25
      STZ1 = '-0.12345678901234567890123456785'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 26
      STZ1 = '-0.12345678901234567890123456785'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 27
      STZ1 = '-0.12345678901234567890123456775'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 28
      STZ1 = '-0.123456789012345678901234567850000000000000000000000000000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345679'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = 2 ')

      NCASE = 29
      STZ1 = '-0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 30
      STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 31
      STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = -1 ')

      NCASE = 32
      STZ1 = '-0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 33
      STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 34
      STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345678'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = 0 ')

      NCASE = 35
      STZ1 = '-0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 36
      STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 37
      STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.1234567890123456789012345677'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = 1 ')
      CALL FM_SETVAR(' MBASE = 2 ')
      CALL FM_SETVAR(' NDIG = 53 ')

      NCASE = 38
      STZ1 = '0.9'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 39
      STZ1 = '0.9'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.90000000000000002220446049250313080847263336181640625'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 40
      STZ1 = '0.900000000000000077715611723760957829654216766357421875'
      M_C =  TO_FM(STZ1)
      M_D = NEAREST( TO_FM(9)/10 , TO_FM(1) )
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 41
      STZ1 = '0.900000000000000077715611723760957829654216766357421875000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      M_D = NEAREST( TO_FM(9)/10 , TO_FM(1) )
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 42
      STZ1 = '0.900000000000000077715611723760957829654216766357421874999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = 2 ')

      NCASE = 43
      STZ1 = '0.9'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 44
      STZ1 = '0.9'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.90000000000000002220446049250313080847263336181640625'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 45
      STZ1 = '0.900000000000000022204460492503130808472633361816406250000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      M_D = NEAREST( TO_FM(9)/10 , TO_FM(1) )
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 46
      STZ1 = '0.900000000000000022204460492503130808472633361816406249999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = -1 ')

      NCASE = 47
      STZ1 = '0.9'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 48
      STZ1 = '0.9'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.899999999999999911182158029987476766109466552734375'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 49
      STZ1 = '0.8999999999999999111821580299874767661094665527343750000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 50
      STZ1 = '0.8999999999999999111821580299874767661094665527343749999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      M_D = NEAREST( TO_FM(9)/10 , TO_FM(-1) )
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = 0 ')

      NCASE = 51
      STZ1 = '0.9'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 52
      STZ1 = '0.9'
      M_C =  TO_FM(STZ1)
      STZ1 = '0.899999999999999911182158029987476766109466552734375'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 53
      STZ1 = '0.8999999999999999111821580299874767661094665527343750000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 54
      STZ1 = '0.8999999999999999111821580299874767661094665527343749999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      M_D = NEAREST( TO_FM(9)/10 , TO_FM(-1) )
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = 1 ')

      NCASE = 55
      STZ1 = '-0.9'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(-9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 56
      STZ1 = '-0.9'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.90000000000000002220446049250313080847263336181640625'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 57
      STZ1 = '-0.900000000000000077715611723760957829654216766357421875'
      M_C =  TO_FM(STZ1)
      M_D = NEAREST( TO_FM(-9)/10 , TO_FM(-1) )
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 58
      STZ1 = '-0.900000000000000077715611723760957829654216766357421875000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      M_D = NEAREST( TO_FM(-9)/10 , TO_FM(-1) )
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 59
      STZ1 = '-0.900000000000000077715611723760957829654216766357421874999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(-9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = 2 ')

      NCASE = 60
      STZ1 = '-0.9'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(-9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 61
      STZ1 = '-0.9'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.899999999999999911182158029987476766109466552734375'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 62
      STZ1 = '-0.899999999999999911182158029987476766109466552734375000000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(-9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 63
      STZ1 = '-0.899999999999999911182158029987476766109466552734374999999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      M_D = NEAREST( TO_FM(-9)/10 , TO_FM(1) )
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = -1 ')

      NCASE = 64
      STZ1 = '-0.9'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(-9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 65
      STZ1 = '-0.9'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.90000000000000002220446049250313080847263336181640625'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 66
      STZ1 = '-0.90000000000000002220446049250313080847263336181640625000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      M_D = NEAREST( TO_FM(-9)/10 , TO_FM(-1) )
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 67
      STZ1 = '-0.90000000000000002220446049250313080847263336181640624999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(-9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' KROUND = 0 ')

      NCASE = 68
      STZ1 = '-0.9'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(-9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 69
      STZ1 = '-0.9'
      M_C =  TO_FM(STZ1)
      STZ1 = '-0.899999999999999911182158029987476766109466552734375'
      M_D = TO_FM(STZ1)
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 70
      STZ1 = '-0.8999999999999999111821580299874767661094665527343749999999999999999999999999999'
      M_C =  TO_FM(STZ1)
      M_D = NEAREST( TO_FM(-9)/10 , TO_FM(1) )
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 71
      STZ1 = '-0.8999999999999999111821580299874767661094665527343750000000000000000000000000001'
      M_C =  TO_FM(STZ1)
      M_D = TO_FM(-9)/10
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FM_SETVAR(' MBASE = 10000 ')
      CALL FM_SETVAR(' NDIG = 25 ')
      CALL FMSETVAR(' KROUND = 1 ')

      NCASE = 72
      STZ1 = '0.1234567890123456'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F20.14',M_A,ST1)
      WRITE (ST2,"(F20.14)") TO_DP(M_A)
      K = INDEX(ST2,'0.')
      IF (K > 0) ST2(K:K) = ' '
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 73
      STZ1 = '3.1234567890123456'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F20.14',M_A,ST1)
      WRITE (ST2,"(F20.14)") TO_DP(M_A)
      K = INDEX(ST2,'0.')
      IF (K > 0) ST2(K:K) = ' '
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 74
      STZ1 = '-3.1234567890123456'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F20.13',M_A,ST1)
      WRITE (ST2,"(F20.13)") TO_DP(M_A)
      K = INDEX(ST2,'0.')
      IF (K > 0) ST2(K:K) = ' '
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 75
      STZ1 = '3.1234567890123456e4'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('E25.14',M_A,ST1)
      WRITE (ST2,"(E25.14)") TO_DP(M_A)
      K = INDEX(ST2,'E+05')
      IF (K > 0) ST2(K:K+3) = 'M+5 '
      K = INDEX(ST2,'0.')
      IF (K > 0) THEN
          STZ2 = ST2(K+1:30)
          ST2(2:31) = STZ2(1:30)
      ENDIF
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 76
      STZ1 = '-3.1234567890123456e4'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('E25.13',M_A,ST1)
      WRITE (ST2,"(E25.13)") TO_DP(M_A)
      K = INDEX(ST2,'E+05')
      IF (K > 0) ST2(K:K+3) = 'M+5 '
      K = INDEX(ST2,'-0.')
      IF (K > 0) THEN
          ST2(K:K+1) = ' -'
          STZ2 = ST2(K+1:31)
          ST2(1:30) = STZ2(1:30)
      ENDIF
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 77
      STZ1 = '3.1234567890123456e4'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('ES25.14',M_A,ST1)
      WRITE (ST2,"(ES25.14)") TO_DP(M_A)
      K = INDEX(ST2,'E+04')
      IF (K > 0) ST2(K:K+3) = 'M+4 '
      K = INDEX(ST2,'3.')
      IF (K > 0) THEN
          STZ2 = ST2(K:30)
          ST2(2:31) = STZ2(1:30)
      ENDIF
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 78
      STZ1 = '-3.1234567890123456e4'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('ES25.13',M_A,ST1)
      WRITE (ST2,"(ES25.13)") TO_DP(M_A)
      K = INDEX(ST2,'E+04')
      IF (K > 0) ST2(K:K+3) = 'M+4 '
      K = INDEX(ST2,'-3.')
      IF (K > 0) THEN
          STZ2 = ST2(K:31)
          ST2(1:30) = STZ2(1:30)
      ENDIF
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 79
      STZ1 = '0.123456789012345678901234567849999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345678'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 80
      STZ1 = '0.123456789012345678901234567850000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345679'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 81
      STZ1 = '0.123456789012345678901234567850000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345678'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 82
      STZ1 = '0.123456789012345678901234567750000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345678'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 83
      STZ1 = '0.12345678901234567890123456749999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234567'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 84
      STZ1 = '0.12345678901234567890123456750000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234568'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 85
      STZ1 = '0.12345678901234567890123456750000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234568'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 86
      STZ1 = '0.12345678901234567890123456650000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234566'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 87
      STZ1 = '-0.123456789012345678901234567849999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345678'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 88
      STZ1 = '-0.123456789012345678901234567850000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345679'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 89
      STZ1 = '-0.123456789012345678901234567850000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345678'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 90
      STZ1 = '-0.123456789012345678901234567750000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345678'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 91
      STZ1 = '-0.12345678901234567890123456749999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234567'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 92
      STZ1 = '-0.12345678901234567890123456750000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234568'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 93
      STZ1 = '-0.12345678901234567890123456750000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234568'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 94
      STZ1 = '-0.12345678901234567890123456650000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234566'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      CALL FM_SETVAR(' MBASE = 10000 ')
      CALL FM_SETVAR(' NDIG = 25 ')
      CALL FMSETVAR(' KROUND = 2 ')

      NCASE = 95
      STZ1 = '0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345679'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 96
      STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345679'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 97
      STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345678'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 98
      STZ1 = '0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234568'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 99
      STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234568'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 100
      STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234567'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 101
      STZ1 = '-0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345678'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 102
      STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345678'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 103
      STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345678'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 104
      STZ1 = '-0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234567'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 105
      STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234567'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 106
      STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234567'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      CALL FM_SETVAR(' MBASE = 10000 ')
      CALL FM_SETVAR(' NDIG = 25 ')
      CALL FMSETVAR(' KROUND = -1 ')

      NCASE = 107
      STZ1 = '0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345678'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 108
      STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345678'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 109
      STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345678'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 110
      STZ1 = '0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234567'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 111
      STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234567'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 112
      STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234567'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 113
      STZ1 = '-0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345679'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 114
      STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345679'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 115
      STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345678'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 116
      STZ1 = '-0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234568'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 117
      STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234568'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 118
      STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234567'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      CALL FM_SETVAR(' MBASE = 10000 ')
      CALL FM_SETVAR(' NDIG = 25 ')
      CALL FMSETVAR(' KROUND = 0 ')

      NCASE = 119
      STZ1 = '0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345678'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 120
      STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345678'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 121
      STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  .1234567890123456789012345678'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 122
      STZ1 = '0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234567'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 123
      STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234567'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 124
      STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  .123456789012345678901234567'
      ST2 = '    '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 125
      STZ1 = '-0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345678'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 126
      STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345678'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 127
      STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F35.28',M_A,ST1)
      ST2 = '  -.1234567890123456789012345678'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 128
      STZ1 = '-0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234567'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 129
      STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234567'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 130
      STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
      M_A =  TO_FM(STZ1)
      CALL FM_FORM('F34.27',M_A,ST1)
      ST2 = '  -.123456789012345678901234567'
      ST2 = '   '//ST2
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      CALL FM_SETVAR(' MBASE = 2 ')
      CALL FM_SETVAR(' NDIG = 53 ')
      CALL FMSETVAR(' KROUND = 1 ')

      NCASE = 131
      M_A =  TO_FM('6965949469487146') * TO_FM(2)**(-249)
      CALL FM_FORM('E25.13',M_A,ST1)
      ST2 = ' .7700366561890M-59'
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 132
      M_A =  TO_FM('-6965949469487146') * TO_FM(2)**(-249)
      CALL FM_FORM('E25.13',M_A,ST1)
      ST2 = '-.7700366561890M-59'
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      CALL FMSETVAR(' KROUND = 2 ')

      NCASE = 133
      M_A =  TO_FM('6965949469487146') * TO_FM(2)**(-249)
      CALL FM_FORM('E25.14',M_A,ST1)
      ST2 = ' .77003665618896M-59'
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 134
      M_A =  TO_FM('-6965949469487146') * TO_FM(2)**(-249)
      CALL FM_FORM('E25.14',M_A,ST1)
      ST2 = '-.77003665618895M-59'
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      CALL FMSETVAR(' KROUND = -1 ')

      NCASE = 135
      M_A =  TO_FM('6965949469487146') * TO_FM(2)**(-249)
      CALL FM_FORM('E25.14',M_A,ST1)
      ST2 = ' .77003665618895M-59'
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 136
      M_A =  TO_FM('-6965949469487146') * TO_FM(2)**(-249)
      CALL FM_FORM('E25.14',M_A,ST1)
      ST2 = '-.77003665618896M-59'
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      CALL FMSETVAR(' KROUND = 0 ')

      NCASE = 137
      M_A =  TO_FM('6965949469487146') * TO_FM(2)**(-249)
      CALL FM_FORM('E25.14',M_A,ST1)
      ST2 = ' .77003665618895M-59'
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 138
      M_A =  TO_FM('-6965949469487146') * TO_FM(2)**(-249)
      CALL FM_FORM('E25.14',M_A,ST1)
      ST2 = '-.77003665618895M-59'
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 139
      CALL FMSETVAR(' KROUND = 1 ')
      M_A = TO_FM('1.2e+44444444444444444444444444444444444444444444444444444444444')
      CALL FM_FORM('E25.14',M_A,ST1)
      M_B = TO_FM(' +OVERFLOW ')
      CALL FM_FORM('E25.14',M_B,ST2)
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 140
      M_A = TO_FM('-1.2e+44444444444444444444444444444444444444444444444444444444444')
      CALL FM_FORM('E25.14',M_A,ST1)
      M_B = TO_FM(' -OVERFLOW ')
      CALL FM_FORM('E25.14',M_B,ST2)
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 141
      M_A = TO_FM('1.2e-44444444444444444444444444444444444444444444444444444444444')
      CALL FM_FORM('E25.14',M_A,ST1)
      M_B = TO_FM(' +UNDERFLOW ')
      CALL FM_FORM('E25.14',M_B,ST2)
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 142
      M_A = TO_FM('-1.2e-44444444444444444444444444444444444444444444444444444444444')
      CALL FM_FORM('E25.14',M_A,ST1)
      M_B = TO_FM(' -UNDERFLOW ')
      CALL FM_FORM('E25.14',M_B,ST2)
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      CALL FM_SET(50)

      NCASE = 143
      M_A = TO_FM('1.2e+44444444444444444444444444444444444444444444444444444444444')
      CALL FM_FORM('E25.14',M_A,ST1)
      M_B = TO_FM(' +OVERFLOW ')
      CALL FM_FORM('E25.14',M_B,ST2)
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 144
      M_A = TO_FM('-1.2e+44444444444444444444444444444444444444444444444444444444444')
      CALL FM_FORM('E25.14',M_A,ST1)
      M_B = TO_FM(' -OVERFLOW ')
      CALL FM_FORM('E25.14',M_B,ST2)
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 145
      M_A = TO_FM('1.2e-44444444444444444444444444444444444444444444444444444444444')
      CALL FM_FORM('E25.14',M_A,ST1)
      M_B = TO_FM(' +UNDERFLOW ')
      CALL FM_FORM('E25.14',M_B,ST2)
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      NCASE = 146
      M_A = TO_FM('-1.2e-44444444444444444444444444444444444444444444444444444444444')
      CALL FM_FORM('E25.14',M_A,ST1)
      M_B = TO_FM(' -UNDERFLOW ')
      CALL FM_FORM('E25.14',M_B,ST2)
      IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)

      CALL FM_SET(50)
      RETURN
      END SUBROUTINE TEST1

      SUBROUTINE TEST2

!  Test add and subtract.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing add and subtract routines.')")

      NCASE = 147
      CALL FMST2M('123',MA)
      CALL FMST2M('789',MB)
      CALL FMADD(MA,MB,ME)
      CALL FMEQ(ME,MA)
      CALL FMI2M(912,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMADD ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 148
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMADD(MA,MB,ME)
      CALL FMEQ(ME,MA)
      ST2 = '1.0824742268041237113402061855670103092783505154639175'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMADD ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 149
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMSUB(MA,MB,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-.3814432989690721649484536082474226804123711340206185'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMSUB ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 150
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.3505154639175257731443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMSUB(MA,MB,ME)
      CALL FMEQ(ME,MA)
      ST2 = '5.15463917525773195876288659793815M-20'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMSUB ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 151
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMADDI(MA,1)
      ST2 = '1.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMADDI',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 152
      ST1 = '4.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMADDI(MA,5)
      ST2 = '9.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMADDI',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      RETURN
      END SUBROUTINE TEST2

      SUBROUTINE TEST3

!  Test multiply, divide and square root.

      IMPLICIT NONE

      CHARACTER(2000), SAVE :: STB
      TYPE (FM), SAVE :: M_H1, M_H2

      WRITE (KW,"(/' Testing multiply, divide and square root routines.')")

      NCASE = 153
      CALL FMST2M('123',MA)
      CALL FMST2M('789',MB)
      CALL FMMPY(MA,MB,ME)
      CALL FMEQ(ME,MA)
      CALL FMI2M(97047,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMMPY ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 154
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMMPY(MA,MB,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.2565628653416941226485280051014985652035285365075991'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMMPY ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 155
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMDIV(MA,MB,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.4788732394366197183098591549295774647887323943661972'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMDIV ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 156
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MA)
      CALL FMMPYI(MA,14,ME)
      CALL FMEQ(ME,MA)
      ST2 = '10.2474226804123711340206185567010309278350515463917526'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMMPYI',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 157
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MA)
      CALL FMDIVI(MA,24,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.0304982817869415807560137457044673539518900343642612'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMDIVI',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 158
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSQR(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.1228610904453183122542246784993091720692953555106813'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMSQR ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 159
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSQRT(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.5920434645509785316136003710368759268547372945659987'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMSQRT',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 160

!             Test allocate statements by a sequence of operations at increasing precision.
!             Also test FM_ENTER_USER_FUNCTION and FM_EXIT_USER_FUNCTION.

      CALL FMSET(500)
      M_H1 = HARMONIC_SUM(150)
      M_H2 = 1
      DO J = 2, 150
         M_H2 = M_H2 + 1/TO_FM(J)
      ENDDO
      MFM3 = ABS(M_H2 - M_H1)
      CALL FM_ST2M(' 1.0E-495 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 161
      MFM3 = M_H1*10**6
      CALL FM_FORM("I750",MFM3,STB(1:800))
      MFM3 = NINT(M_H1*10**6)
      MFM3 = ABS(MFM3 - TO_FM(STB(1:800)))
      IF (.NOT.(MFM3 == 0)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 162
      MFM3 = M_H1*10**6
      CALL FM_FORM("F902.900",MFM3,STB(1:910))
      MFM3 = M_H1*10**6
      MFM3 = ABS(MFM3 - TO_FM(STB(1:910)))
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 163
      MZM3 = M_H1*10**6
      CALL ZM_FORM("F902.900","F902.900",MZM3,STB(1:1820))
      MZM3 = M_H1*10**6
      MFM3 = ABS(MZM3 - TO_ZM(STB(1:1820)))
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      CALL FMSET(50)

      NCASE = 164
      MFM3 = 200
      MFM3 = FACTORIAL(MFM3)
      MFM4 = FACTORIAL2(200)
      MFM5 = ABS((MFM3-MFM4)/MFM3)
      IF (.NOT.(MFM5 < 1.0D-50)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 165
      MFM3 = 200
      MFM3 = FACTORIAL(MFM3)
      MIM4 = I_FACTORIAL(200)
      MFM5 = ABS((MFM3-MIM4)/MFM3)
      IF (.NOT.(MFM5 < 1.0D-50)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF
      NCASE = 166
      MFM3 = 200
      MFM4 = 99
      MFM3 = BINOMIAL(MFM3,MFM4)
      MZM4 = Z_FACTORIAL(200) / ( Z_FACTORIAL(99) * Z_FACTORIAL(101) )
      MFM5 = ABS((MFM3-MZM4)/MFM3)
      IF (.NOT.(MFM5 < 1.0D-50)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 167
      CALL H_SUM(TO_FM(0),1,150,MFM3)
      MFM4 = HARMONIC_SUM(150)
      MFM5 = ABS((MFM3-MFM4)/MFM3)
      IF (.NOT.(MFM5 < 1.0D-50)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 168
      MFMA(1,1:3) = (/ 3 , 1 , 4 /)
      MFMA(2,1:3) = (/ 1 , 5 , 9 /)
      MFMA(3,1:3) = (/ 2 , 6 , 5 /)
      MFMV1(1:3) = (/ 3.15D0 , 7.23D0 , 6.14D0 /)
      DO K = 1, 5
         MFMV1 = POWER(MFMA,MFMV1)
      ENDDO
      MFMV2 = (/  TO_FM(' 3.1542643547290503520828034216804200150468262227735M-1 ') ,  &
                  TO_FM(' 7.2306108656733102850197507313845978717562385025770M-1 ') ,  &
                  TO_FM(' 6.1456393393765623787137563007322207735298613009209M-1 ')    /)
      MFM5 = SQRT(DOT_PRODUCT(MFMV2-MFMV1,MFMV2-MFMV1))
      IF (.NOT.(MFM5 < 1.0D-20)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 169
      MIMA2(1,1:3) = (/ 3 , 1 , 4 /)
      MIMA2(2,1:3) = (/ 1 , 5 , 9 /)
      MIMA2(3,1:3) = (/ 2 , 6 , 5 /)
      MIMV1(1:3) = (/ 3.15D0 , 7.23D0 , 6.14D0 /) * 1.0D+20
      DO K = 1, 5
         MIMV1 = POWER(MIMA2,MIMV1)
      ENDDO
      MIMV2 = (/  TO_IM(' 31542643547290503520 ') ,  &
                  TO_IM(' 72306108656733102850 ') ,  &
                  TO_IM(' 61456393393765623787 ')    /)
      MFM5 = SQRT(TO_FM(DOT_PRODUCT(MIMV2-MIMV1,MIMV2-MIMV1)))
      IF (.NOT.(MFM5 < 1.0D+10)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 170
      MZMA2(1,1:3) = (/ 3 , 1 , 4 /)
      MZMA2(2,1:3) = (/ 1 , 5 , 9 /)
      MZMA2(3,1:3) = (/ 2 , 6 , 5 /)
      MZMV1(1:3) = (/ 3.15D0 , 7.23D0 , 6.14D0 /)
      MZMV1 = MZMV1 + TO_ZM(' 1E-3 i ')
      DO K = 1, 5
         MZMV1 = POWER(MZMA2,MZMV1)
      ENDDO
      MZMV2 = (/  TO_ZM(' 3.1542643130468500872641541678834676897138030382982M-1 +' //   &
                        ' 5.1278981926487839881349589767671081443509643262661M-5 i ') ,  &
                  TO_ZM(' 7.2306107701240042517092650862644370372071840430102M-1 +' //   &
                        ' 1.1754827305696904820108498770289645838406851701631M-4 i ') ,  &
                  TO_ZM(' 6.1456392581646724129324988735501670763785588781979M-1 +' //   &
                        ' 9.9909857541381365264205184957852886329504658229615M-5 i ')    /)
      MFM5 = SQRT(ABS(DOT_PRODUCT(MZMV2-MZMV1,MZMV2-MZMV1)))
      IF (.NOT.(MFM5 < 1.0D-20)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      RETURN
      END SUBROUTINE TEST3

      FUNCTION HARMONIC_SUM(N)
      USE FMZM
      IMPLICIT NONE

      TYPE (FM) :: HARMONIC_SUM
      TYPE (FM), SAVE :: T(500)
      INTEGER :: J,N

      CALL FM_ENTER_USER_FUNCTION(HARMONIC_SUM)

      DO J = 1, N
          T(J) = 1/TO_FM(J)
      ENDDO
      HARMONIC_SUM = 0
      DO J = 1, N
          HARMONIC_SUM = HARMONIC_SUM + T(J)
      ENDDO
      CALL FM_EXIT_USER_FUNCTION(HARMONIC_SUM)

      END FUNCTION HARMONIC_SUM

      FUNCTION FACTORIAL2(N)
      USE FMVALS
      USE FMZM
      IMPLICIT NONE

      TYPE (FM) :: FACTORIAL2
      TYPE (FM), SAVE :: LOW_PREC, ERR
      INTEGER :: J,N,ND1,ND2

      CALL FM_ENTER_USER_FUNCTION(FACTORIAL2)

      FACTORIAL2 = 1
      DO J = 2, N
         FACTORIAL2 = J*FACTORIAL2
      ENDDO

!             Raise precision and compute the error in the first factorial.

      ND1 = NDIG
      CALL FM_SET(100)
      ND2 = NDIG
      CALL FM_EQU(FACTORIAL2,LOW_PREC,ND1,ND2)

      FACTORIAL2 = 1
      DO J = 2, N
         FACTORIAL2 = J*FACTORIAL2
      ENDDO

      ERR = ABS( (FACTORIAL2-LOW_PREC) / FACTORIAL2 )
      IF (ERR > 1.0D-50) WRITE (*,*) ' Error is too high in FACTORIAL2.'

      CALL FM_SET(50)
      FACTORIAL2 = LOW_PREC

      CALL FM_EXIT_USER_FUNCTION(FACTORIAL2)
      END FUNCTION FACTORIAL2

      FUNCTION I_FACTORIAL(N)
      USE FMZM
      IMPLICIT NONE

      TYPE (IM) :: I_FACTORIAL
      INTEGER :: J,N

      CALL FM_ENTER_USER_FUNCTION(I_FACTORIAL)

      I_FACTORIAL = 1
      DO J = 2, N
         I_FACTORIAL = J*I_FACTORIAL
      ENDDO

      CALL FM_EXIT_USER_FUNCTION(I_FACTORIAL)
      END FUNCTION I_FACTORIAL

      FUNCTION Z_FACTORIAL(N)
      USE FMVALS
      USE FMZM
      IMPLICIT NONE

!  This complex "factorial" is equal to  N! * (1+i)^N.

!  For the complex "binomial", the result is always the same as the real binomial.

      TYPE (ZM) :: Z_FACTORIAL
      TYPE (ZM), SAVE :: TERM, LOW_PREC
      TYPE (FM), SAVE :: ERR
      INTEGER :: J,N,ND1,ND2

      CALL FM_ENTER_USER_FUNCTION(Z_FACTORIAL)

      Z_FACTORIAL = CMPLX( TO_FM('1.0D0') , TO_FM('0.0D0') )
      TERM = CMPLX( TO_FM('0.0D0') , TO_FM('0.0D0') )
      DO J = 1, N
         TERM = TERM + CMPLX( TO_FM('1.0D0') , TO_FM('1.0D0') )
         Z_FACTORIAL = TERM*Z_FACTORIAL
      ENDDO

!             Raise precision and compute the error in the first factorial.

      ND1 = NDIG
      CALL FM_SET(100)
      ND2 = NDIG
      CALL ZM_EQU(Z_FACTORIAL,LOW_PREC,ND1,ND2)

      Z_FACTORIAL = CMPLX( TO_FM('1.0D0') , TO_FM('0.0D0') )
      TERM = CMPLX( TO_FM('0.0D0') , TO_FM('0.0D0') )
      DO J = 1, N
         TERM = TERM + CMPLX( TO_FM('1.0D0') , TO_FM('1.0D0') )
         Z_FACTORIAL = TERM*Z_FACTORIAL
      ENDDO

      ERR = ABS( (Z_FACTORIAL-LOW_PREC) / Z_FACTORIAL )
      IF (ERR > 1.0D-50) WRITE (*,*) ' Error is too high in Z_FACTORIAL.'

      CALL FM_SET(50)
      Z_FACTORIAL = LOW_PREC

      CALL FM_EXIT_USER_FUNCTION(Z_FACTORIAL)
      END FUNCTION Z_FACTORIAL

      SUBROUTINE H_SUM(START,J1,J2,RESULT)
      USE FMZM
      IMPLICIT NONE

      TYPE (FM) :: START, RESULT
      INTEGER :: J,J1,J2

      CALL FM_ENTER_USER_ROUTINE
      RESULT = START
      DO J = J1, J2
          RESULT = RESULT + TO_FM(1)/J
      ENDDO

      CALL FM_EXIT_USER_ROUTINE
      END SUBROUTINE H_SUM

      FUNCTION POWER_FM(A,X)

      USE FMVALS
      USE FMZM
      IMPLICIT NONE

      TYPE (FM) :: A(3,3),X(3),POWER_FM(3)

      CALL FM_ENTER_USER_FUNCTION(POWER_FM)

      POWER_FM = MATRIX_PRODUCT(MATRIX_SQUARE(A),X)

!             Normalize the eigenvector (L-2 norm).

      POWER_FM = POWER_FM / SQRT( DOT_PRODUCT(POWER_FM,POWER_FM) )

      CALL FM_EXIT_USER_FUNCTION(POWER_FM)

      END FUNCTION POWER_FM

      FUNCTION MATRIX_PRODUCT_FM(A,X)

      USE FMVALS
      USE FMZM
      IMPLICIT NONE

      TYPE (FM) :: A(3,3),X(3),MATRIX_PRODUCT_FM(3)
      TYPE (FM), SAVE :: X2(3),A2
      INTEGER :: J,K

      CALL FM_ENTER_USER_FUNCTION(MATRIX_PRODUCT_FM)

!             Test the move logic in FM_EXIT_USER_FUNCTION by raising precision and doing
!             matmul by hand.

      NDIG = 2*NDIG
      DO J = 1, 3
         MATRIX_PRODUCT_FM(J) = 0
         DO K = 1, 3
            CALL FM_EQU(A(J,K),A2,NDIG/2,NDIG)
            CALL FM_EQU(X(K),X2(K),NDIG/2,NDIG)
            MATRIX_PRODUCT_FM(J) = MATRIX_PRODUCT_FM(J) + A2*X2(K)
         ENDDO
      ENDDO

      X2 = MATRIX_PRODUCT_FM
      DO J = 1, 3
         CALL FM_EQU(X2(J),MATRIX_PRODUCT_FM(J),NDIG,NDIG/2)
      ENDDO

      NDIG = NDIG/2

      CALL FM_EXIT_USER_FUNCTION(MATRIX_PRODUCT_FM)

      END FUNCTION MATRIX_PRODUCT_FM

      FUNCTION MATRIX_SQUARE_FM(A)

      USE FMVALS
      USE FMZM
      IMPLICIT NONE

      TYPE (FM) :: A(3,3),MATRIX_SQUARE_FM(3,3)
      TYPE (FM), SAVE :: A2(3,3),ROW,COL
      INTEGER :: J,K,L

      CALL FM_ENTER_USER_FUNCTION(MATRIX_SQUARE_FM)

!             Test the move logic in FM_EXIT_USER_FUNCTION by raising precision and doing
!             matmul by hand.

      NDIG = 2*NDIG
      DO J = 1, 3
         DO K = 1, 3
            MATRIX_SQUARE_FM(J,K) = 0
            DO L = 1, 3
               CALL FM_EQU(A(J,L),ROW,NDIG/2,NDIG)
               CALL FM_EQU(A(L,K),COL,NDIG/2,NDIG)
               MATRIX_SQUARE_FM(J,K) = MATRIX_SQUARE_FM(J,K) + ROW*COL
            ENDDO
         ENDDO
      ENDDO

      A2 = MATRIX_SQUARE_FM
      DO J = 1, 3
         DO K = 1, 3
            CALL FM_EQU(A2(J,K),MATRIX_SQUARE_FM(J,K),NDIG,NDIG/2)
         ENDDO
      ENDDO

      NDIG = NDIG/2

      CALL FM_EXIT_USER_FUNCTION(MATRIX_SQUARE_FM)

      END FUNCTION MATRIX_SQUARE_FM

      FUNCTION POWER_IM(A,X)

      USE FMVALS
      USE FMZM
      IMPLICIT NONE

      TYPE (IM) :: A(3,3),X(3),POWER_IM(3)

      CALL FM_ENTER_USER_FUNCTION(POWER_IM)

      POWER_IM = MATRIX_PRODUCT(MATRIX_SQUARE(A),X)

!             Normalize the eigenvector (L-2 norm).

      POWER_IM = POWER_IM / ( TO_FM('1e-20') * SQRT( TO_FM( DOT_PRODUCT(POWER_IM,POWER_IM) ) ) )

      CALL FM_EXIT_USER_FUNCTION(POWER_IM)

      END FUNCTION POWER_IM

      FUNCTION MATRIX_PRODUCT_IM(A,X)

      USE FMVALS
      USE FMZM
      IMPLICIT NONE

      TYPE (IM) :: A(3,3),X(3),MATRIX_PRODUCT_IM(3)
      INTEGER :: J,K

      CALL FM_ENTER_USER_FUNCTION(MATRIX_PRODUCT_IM)

!             Test the move logic in FM_EXIT_USER_FUNCTION by doing matmul by hand.

      DO J = 1, 3
         MATRIX_PRODUCT_IM(J) = 0
         DO K = 1, 3
            MATRIX_PRODUCT_IM(J) = MATRIX_PRODUCT_IM(J) + A(J,K)*X(K)
         ENDDO
      ENDDO

      CALL FM_EXIT_USER_FUNCTION(MATRIX_PRODUCT_IM)

      END FUNCTION MATRIX_PRODUCT_IM

      FUNCTION MATRIX_SQUARE_IM(A)

      USE FMVALS
      USE FMZM
      IMPLICIT NONE

      TYPE (IM) :: A(3,3),MATRIX_SQUARE_IM(3,3)
      INTEGER :: J,K,L

      CALL FM_ENTER_USER_FUNCTION(MATRIX_SQUARE_IM)

!             Test the move logic in FM_EXIT_USER_FUNCTION by setting element 2,3 to a large value.

      MATRIX_SQUARE_IM(2,3) = TO_IM(10)**100
      DO J = 1, 3
         DO K = 1, 3
            MATRIX_SQUARE_IM(J,K) = 0
            DO L = 1, 3
               MATRIX_SQUARE_IM(J,K) = MATRIX_SQUARE_IM(J,K) + A(J,L)*A(L,K)
            ENDDO
         ENDDO
      ENDDO

      CALL FM_EXIT_USER_FUNCTION(MATRIX_SQUARE_IM)

      END FUNCTION MATRIX_SQUARE_IM

      FUNCTION POWER_ZM(A,X)

      USE FMVALS
      USE FMZM
      IMPLICIT NONE

      TYPE (ZM) :: A(3,3),X(3),POWER_ZM(3)

      CALL FM_ENTER_USER_FUNCTION(POWER_ZM)

      POWER_ZM = MATRIX_PRODUCT(MATRIX_SQUARE(A),X)

!             Normalize the eigenvector (L-2 norm).

      POWER_ZM = POWER_ZM / SQRT( DOT_PRODUCT(POWER_ZM,POWER_ZM) )

      CALL FM_EXIT_USER_FUNCTION(POWER_ZM)

      END FUNCTION POWER_ZM

      FUNCTION MATRIX_PRODUCT_ZM(A,X)

      USE FMVALS
      USE FMZM
      IMPLICIT NONE

      TYPE (ZM) :: A(3,3),X(3),MATRIX_PRODUCT_ZM(3)
      TYPE (ZM), SAVE :: X2(3),A2
      INTEGER :: J,K

      CALL FM_ENTER_USER_FUNCTION(MATRIX_PRODUCT_ZM)

!             Test the move logic in FM_EXIT_USER_FUNCTION by raising precision and doing
!             matmul by hand.

      NDIG = 2*NDIG
      DO J = 1, 3
         MATRIX_PRODUCT_ZM(J) = 0
         DO K = 1, 3
            CALL ZM_EQU(A(J,K),A2,NDIG/2,NDIG)
            CALL ZM_EQU(X(K),X2(K),NDIG/2,NDIG)
            MATRIX_PRODUCT_ZM(J) = MATRIX_PRODUCT_ZM(J) + A2*X2(K)
         ENDDO
      ENDDO

      X2 = MATRIX_PRODUCT_ZM
      DO J = 1, 3
         CALL ZM_EQU(X2(J),MATRIX_PRODUCT_ZM(J),NDIG,NDIG/2)
      ENDDO

      NDIG = NDIG/2

      CALL FM_EXIT_USER_FUNCTION(MATRIX_PRODUCT_ZM)

      END FUNCTION MATRIX_PRODUCT_ZM

      FUNCTION MATRIX_SQUARE_ZM(A)

      USE FMVALS
      USE FMZM
      IMPLICIT NONE

      TYPE (ZM) :: A(3,3),MATRIX_SQUARE_ZM(3,3)
      TYPE (ZM), SAVE :: A2(3,3),ROW,COL
      INTEGER :: J,K,L

      CALL FM_ENTER_USER_FUNCTION(MATRIX_SQUARE_ZM)

!             Test the move logic in FM_EXIT_USER_FUNCTION by raising precision and doing
!             matmul by hand.

      NDIG = 2*NDIG
      DO J = 1, 3
         DO K = 1, 3
            MATRIX_SQUARE_ZM(J,K) = 0
            DO L = 1, 3
               CALL ZM_EQU(A(J,L),ROW,NDIG/2,NDIG)
               CALL ZM_EQU(A(L,K),COL,NDIG/2,NDIG)
               MATRIX_SQUARE_ZM(J,K) = MATRIX_SQUARE_ZM(J,K) + ROW*COL
            ENDDO
         ENDDO
      ENDDO

      A2 = MATRIX_SQUARE_ZM
      DO J = 1, 3
         DO K = 1, 3
            CALL ZM_EQU(A2(J,K),MATRIX_SQUARE_ZM(J,K),NDIG,NDIG/2)
         ENDDO
      ENDDO

      NDIG = NDIG/2

      CALL FM_EXIT_USER_FUNCTION(MATRIX_SQUARE_ZM)

      END FUNCTION MATRIX_SQUARE_ZM

      SUBROUTINE TEST4

!  Test stored constants.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing stored constants.'//'     Check e.'/)")

!             Switch to base 10 and check the stored digits.

      MBSAVE = MBASE
      NDGSAV = NDIG
      NCASE = 171
      CALL FMSETVAR(' MBASE = 1000 ')
      CALL FMSETVAR(' NDIG = 55 ')
      CALL FMCONS
      CALL FMI2M(1,MB)
      CALL FMEXP(MB,MC)
      DO J = 49, 51
         NDIG = J
         NDIGE = 0
         CALL FMI2M(1,MB)
         CALL FMEXP(MB,MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,ME)
         CALL FMEQ(ME,MD)
         CALL FMI2M(1000,MB)
         JEXP = -J + 1
         CALL FMIPOWER(MB,JEXP,ME)
         CALL FMEQ(ME,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRTFM(' e    ',MA,'MA',MC,'MC',MD,'MD')
             EXIT
         ENDIF
      ENDDO

      NCASE = 172
      CALL FM_SETVAR(' MBASE = 1000 ')
      CALL FM_SETVAR(' NDIG = 55 ')
      CALL FMI2M(2,MB)
      CALL FMLN(MB,MC)
      CALL FMEQ(MLN2,MLNSV2)
      CALL FMEQ(MLN3,MLNSV3)
      CALL FMEQ(MLN5,MLNSV5)
      CALL FMEQ(MLN7,MLNSV7)
      WRITE (KW,"('     Check ln(2).'/)")
      DO J = 49, 51
         NDIG = J
         NDIGLI = 0
         CALL FMI2M(2,MB)
         CALL FMLN(MB,MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,ME)
         CALL FMEQ(ME,MD)
         CALL FMI2M(1000,MB)
         JEXP = -J
         CALL FMIPOWER(MB,JEXP,ME)
         CALL FMEQ(ME,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRTFM(' ln(2)',MA,'MA',MC,'MC',MD,'MD')
             EXIT
         ENDIF
      ENDDO

      NCASE = 173
      CALL FMSETVAR(' MBASE = 1000 ')
      CALL FMSETVAR(' NDIG = 55 ')
      WRITE (KW,"('     Check ln(3).'/)")
      CALL FMEQ(MLNSV3,MC)
      DO J = 49, 51
         NDIG = J
         NDIGLI = 0
         CALL FMI2M(3,MB)
         CALL FMLN(MB,MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,ME)
         CALL FMEQ(ME,MD)
         CALL FMI2M(1000,MB)
         JEXP = -J + 1
         CALL FMIPOWER(MB,JEXP,ME)
         CALL FMEQ(ME,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRTFM(' ln(3)',MA,'MA',MC,'MC',MD,'MD')
             EXIT
         ENDIF
      ENDDO

      NCASE = 174
      CALL FMSETVAR(' MBASE = 1000 ')
      CALL FMSETVAR(' NDIG = 55 ')
      WRITE (KW,"('     Check ln(5).'/)")
      CALL FMEQ(MLNSV5,MC)
      DO J = 49, 51
         NDIG = J
         NDIGLI = 0
         CALL FMI2M(5,MB)
         CALL FMLN(MB,MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,ME)
         CALL FMEQ(ME,MD)
         CALL FMI2M(1000,MB)
         JEXP = -J + 1
         CALL FMIPOWER(MB,JEXP,ME)
         CALL FMEQ(ME,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRTFM(' ln(5)',MA,'MA',MC,'MC',MD,'MD')
             EXIT
         ENDIF
      ENDDO

      NCASE = 175
      CALL FMSETVAR(' MBASE = 1000 ')
      CALL FMSETVAR(' NDIG = 55 ')
      WRITE (KW,"('     Check ln(7).'/)")
      CALL FMEQ(MLNSV7,MC)
      DO J = 49, 51
         NDIG = J
         NDIGLI = 0
         CALL FMI2M(7,MB)
         CALL FMLN(MB,MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,ME)
         CALL FMEQ(ME,MD)
         CALL FMI2M(1000,MB)
         JEXP = -J + 1
         CALL FMIPOWER(MB,JEXP,ME)
         CALL FMEQ(ME,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRTFM(' ln(7)',MA,'MA',MC,'MC',MD,'MD')
             EXIT
         ENDIF
      ENDDO

      NCASE = 176
      CALL FMSETVAR(' MBASE = 1000 ')
      CALL FMSETVAR(' NDIG = 55 ')
      WRITE (KW,"('     Check pi.')")
      CALL FMPI(MC)
      DO J = 49, 51
         NDIG = J
         NDIGPI = 0
         CALL FMPI(MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,ME)
         CALL FMEQ(ME,MD)
         CALL FMI2M(1000,MB)
         JEXP = -J + 1
         CALL FMIPOWER(MB,JEXP,ME)
         CALL FMEQ(ME,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRTFM(' pi   ',MA,'MA',MC,'MC',MD,'MD')
             EXIT
         ENDIF
      ENDDO

!             Restore base and precision.

      MBASE = MBSAVE
      NDIG = NDGSAV
      CALL FMCONS
      RETURN
      END SUBROUTINE TEST4

      SUBROUTINE TEST5

!  Test exponentials.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing exponential routines.')")

      NCASE = 177
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMEXP(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.7043249420381570899426746185150096342459216636010743'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMEXP ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 178
      ST1 = '5.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMEXP(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '210.7168868293979289717186453717687341395104929999527672'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-48',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMEXP ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 179
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMIPOWER(MA,13,ME)
      CALL FMEQ(ME,MA)
      ST2 = '1.205572620050170403854527299272882946980306577287581E-6'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-56',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMIPWR',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 180
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MA)
      CALL FMIPOWER(MA,-1234,ME)
      CALL FMEQ(ME,MA)
      ST2 = '1.673084074011006302103793189789209370839697748745938E167'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E+120',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMIPWR',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 181
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMPOWER(MA,MB,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.4642420045002127676457665673753493595170650613692580'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMPWR ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 182
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '-34.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMPOWER(MA,MB,ME)
      CALL FMEQ(ME,MA)
      ST2 = '6.504461581246879800523526109766882955934341922848773E15'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-34',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMPWR ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 183
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMRATIONAL_POWER(MA,1,3,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.7050756680967220302067310420367584779561732592049823'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMRPWR',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 184
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MA)
      CALL FMRATIONAL_POWER(MA,-17,5,ME)
      CALL FMEQ(ME,MA)
      ST2 = '2.8889864895853344043562747681699203201333872009477318'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMRPWR',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      RETURN
      END SUBROUTINE TEST5

      SUBROUTINE TEST6

!  Test logarithms.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing logarithm routines.')")

      NCASE = 185
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMLN(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-1.0483504538872214324499548823726586101452117557127813'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMLN  ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 186
      ST1 = '0.3505154639175257731958762886597938144329896907216495E123'
      CALL FMST2M(ST1,MA)
      CALL FMLN(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '282.1696159843803977017629940438041389247902713456262947'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-47',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMLN  ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 187
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMLOG10(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-0.4552928172239897280304530226127473926500843247517120'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMLG10',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 188
      CALL FMLNI(210,MA)
      ST2 = '5.3471075307174686805185894350500696418856767760333836'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMLNI ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 189
      CALL FMLNI(211,MA)
      ST2 = '5.3518581334760664957419562654542801180411581735816684'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMLNI ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      RETURN
      END SUBROUTINE TEST6

      SUBROUTINE TEST7

!  Test trigonometric functions.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing trigonometric routines.')")

      NCASE = 190
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOS(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.9391958366109693586000906984500978377093121163061328'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCOS ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 191
      ST1 = '-43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOS(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.8069765551968063243992244125871029909816207609700968'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCOS ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 192
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSIN(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-0.3433819746180939949443652360333010581867042625893927'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMSIN ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 193
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSIN(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-0.5905834736620182429243173169772978155668602154136946'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMSIN ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 194
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMTAN(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.3656127521360899712035823015565426347554405301360773'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMTAN ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 195
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMTAN(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-0.7318471272291003544610122296764031536071117330470298'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMTAN ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 196
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOS_SIN(MA,ME,MC)
      CALL FMEQ(ME,MA)
      ST2 = '0.9391958366109693586000906984500978377093121163061328'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCSSN',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 197
      ST1 = '-43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOS_SIN(MA,ME,MC)
      CALL FMEQ(ME,MA)
      ST2 = '0.8069765551968063243992244125871029909816207609700968'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCSSN',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 198
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOS_SIN(MA,MC,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-0.3433819746180939949443652360333010581867042625893927'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCSSN',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 199
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOS_SIN(MA,MC,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-0.5905834736620182429243173169772978155668602154136946'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCSSN',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      RETURN
      END SUBROUTINE TEST7

      SUBROUTINE TEST8

!  Test inverse trigonometric functions.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing inverse trigonometric routines.')")

      NCASE = 200
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMACOS(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '1.2126748979730954046873545995574544481988102502510807'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMACOS',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 201
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMACOS(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '1.9289177556166978337752887837220484359983591491240252'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMACOS',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 202
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMASIN(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.3581214288218012145439670920822969938997744494364723'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMASIN',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 203
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMASIN(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-0.3581214288218012145439670920822969938997744494364723'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMASIN',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 204
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMATAN(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.3371339561772373443347761845672381725353758541616570'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMATAN',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 205
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMATAN(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '1.5477326406586162039457549832092678908202994134569781'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMATAN',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      RETURN
      END SUBROUTINE TEST8

      SUBROUTINE TEST9

!  Test hyperbolic functions.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing hyperbolic routines.')")

      NCASE = 206
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOSH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '1.0620620786534654254819884264931372964608741056397718'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCOSH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 207
      ST1 = '-43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOSH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '3.356291383454381441662669560464886179346554730604556E+18'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-31',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCOSH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 208
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSINH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-0.3577371366153083355393138079781276622149524420386975'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMSINH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 209
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSINH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '3.356291383454381441662669560464886179197580776059111E+18'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-31',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMSINH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 210
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMTANH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.3368326049912874057089491946232983472275659538703038'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMTANH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 211
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMTANH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.9999999999999999999999999999999999999556135217341837'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMTANH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 212
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOSH_SINH(MA,ME,MC)
      CALL FMEQ(ME,MA)
      ST2 = '1.0620620786534654254819884264931372964608741056397718'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCHSH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 213
      ST1 = '-43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOSH_SINH(MA,ME,MC)
      CALL FMEQ(ME,MA)
      ST2 = '3.356291383454381441662669560464886179346554730604556E+18'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-31',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCHSH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 214
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOSH_SINH(MA,MC,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-0.3577371366153083355393138079781276622149524420386975'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCHSH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 215
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOSH_SINH(MA,MC,ME)
      CALL FMEQ(ME,MA)
      ST2 = '3.356291383454381441662669560464886179197580776059111E+18'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-31',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMCHSH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 216
      ST1 = '1.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMACOSH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.8145682312133394569318859491699159033639601721643575'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMACSH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 217
      ST1 = '13.505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMACOSH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '3.2948450962476673647889189297232159569768145674952434'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMACSH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 218
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMASINH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.3437080409009545560256440686372325145641850553599511'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMASNH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 219
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMASINH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-0.3437080409009545560256440686372325145641850553599511'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMASNH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 220
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMATANH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.3660312984048094281267903969406473770879220797066105'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMATNH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 221
      ST1 = '-0.433505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMATANH(MA,ME)
      CALL FMEQ(ME,MA)
      ST2 = '-0.464204949915171741212270022987181478095702210696769987'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMATNH',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      RETURN
      END SUBROUTINE TEST9

      SUBROUTINE TEST10

!  Input and output testing for IM routines.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing integer input and output routines.')")

      NCASE = 222
      CALL IMST2M('123',MA)
      CALL IMI2M(123,MC)
      IF (.NOT.IMCOMPARE(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMST2M',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 223
      ST1 = '-350515'
      CALL IMST2M(ST1,MA)
      CALL IMI2M(-350515,MC)
      IF (.NOT.IMCOMPARE(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMST2M',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 224
      ST1 = '19895113660064588580108197261066338165074766609'
      CALL IMST2M(ST1,MA)
      CALL IMI2M(23,MB)
      CALL IMI2M(34,MC)
      CALL IMPOWER(MB,MC,ME)
      CALL IMEQ(ME,MC)
      IF (.NOT.IMCOMPARE(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMPWR ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 225
      ST1 = '-20800708073664542533904165663516279809808659679033703'
      CALL IMST2M(ST1,MA)
      CALL IMI2M(-567,MB)
      CALL IMI2M(19,MC)
      CALL IMPOWER(MB,MC,ME)
      CALL IMEQ(ME,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMPWR ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 226
      ST1 = '19895113660064588580108197261066338165074766609'
      CALL IMST2M(ST1,MA)
      CALL IMFORM('I53',MA,ST2)
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMFORM',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 227
      ST1 = '-20800708073664542533904165663516279809808659679033703'
      CALL IMST2M(ST1,MA)
      CALL IMFORM('I73',MA,ST2)
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMFORM',MA,'MA',MC,'MC')
      ENDIF

      RETURN
      END SUBROUTINE TEST10

      SUBROUTINE TEST11

!  Test add and subtract for IM routines.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing integer add and subtract routines.')")

      NCASE = 228
      CALL IMST2M('123',MA)
      CALL IMST2M('789',MB)
      CALL IMADD(MA,MB,ME)
      CALL IMEQ(ME,MA)
      CALL IMI2M(912,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMADD ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 229
      ST1 = '3505154639175257731958762886597938144329896907216495'
      CALL IMST2M(ST1,MA)
      ST1 = '7319587628865979381443298969072164948453608247422680'
      CALL IMST2M(ST1,MB)
      CALL IMADD(MA,MB,ME)
      CALL IMEQ(ME,MA)
      ST2 = '10824742268041237113402061855670103092783505154639175'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMADD ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 230
      ST1 = '3505154639175257731958762886597938144329896907216495'
      CALL IMST2M(ST1,MA)
      ST1 = '7319587628865979381443298969072164948453608247422680'
      CALL IMST2M(ST1,MB)
      CALL IMSUB(MA,MB,ME)
      CALL IMEQ(ME,MA)
      ST2 = '-3814432989690721649484536082474226804123711340206185'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMSUB ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 231
      ST1 = '3505154639175257731958762886597938144329896907216495'
      CALL IMST2M(ST1,MA)
      ST1 = '3505154639175257731443298969072164948453608247422680'
      CALL IMST2M(ST1,MB)
      CALL IMSUB(MA,MB,ME)
      CALL IMEQ(ME,MA)
      ST2 = '515463917525773195876288659793815'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMSUB ',MA,'MA',MC,'MC')
      ENDIF

      RETURN
      END SUBROUTINE TEST11

      SUBROUTINE TEST12

!  Test integer multiply and divide.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing integer multiply, divide and square routines.')")

      NCASE = 232
      CALL IMST2M('123',MA)
      CALL IMST2M('789',MB)
      CALL IMMPY(MA,MB,ME)
      CALL IMEQ(ME,MA)
      CALL IMI2M(97047,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMMPY ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 233
      ST1 = '10430738374625018354698'
      CALL IMST2M(ST1,MA)
      ST1 = '2879494424799214514791045985'
      CALL IMST2M(ST1,MB)
      CALL IMMPY(MA,MB,ME)
      CALL IMEQ(ME,MA)
      ST2 = '30035252996271960952238822892375588336807158787530'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMMPY ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 234
      CALL IMST2M('12347',MA)
      CALL IMST2M('47',MB)
      CALL IMDIV(MA,MB,ME)
      CALL IMEQ(ME,MA)
      CALL IMST2M('262',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDIV ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 235
      ST1 = '2701314697583086005158008013691015597308949443159762'
      CALL IMST2M(ST1,MA)
      ST1 = '-978132616472842669976589722394'
      CALL IMST2M(ST1,MB)
      CALL IMDIV(MA,MB,ME)
      CALL IMEQ(ME,MA)
      CALL IMST2M('-2761705981469115610382',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDIV ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 236
      CALL IMST2M('12368',MA)
      CALL IMST2M('67',MB)
      CALL IMMOD(MA,MB,ME)
      CALL IMEQ(ME,MB)
      CALL IMST2M('40',MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPRTIM('IMMOD ',MB,'MB',MC,'MC')
      ENDIF

      NCASE = 237
      ST1 = '2701314697583086005158008013691015597308949443159762'
      CALL IMST2M(ST1,MA)
      ST1 = '-978132616472842669976589722394'
      CALL IMST2M(ST1,MB)
      CALL IMMOD(MA,MB,ME)
      CALL IMEQ(ME,MB)
      CALL IMST2M('450750319653685523300198865254',MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPRTIM('IMMOD ',MB,'MB',MC,'MC')
      ENDIF

      NCASE = 238
      CALL IMST2M('1234',MA)
      CALL IMST2M('17',MB)
      CALL IMDIVR(MA,MB,MC,MD)
      CALL IMEQ(MC,MA)
      CALL IMEQ(MD,MB)
      CALL IMST2M('72',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDIVR',MA,'MA',MC,'MC')
      ENDIF
      CALL IMST2M('10',MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDIVR',MB,'MB',MC,'MC')
      ENDIF

      NCASE = 239
      ST1 = '34274652243817531418235301715935108945364446765801943'
      CALL IMST2M(ST1,MA)
      ST1 = '-54708769795848731641842224621693'
      CALL IMST2M(ST1,MB)
      CALL IMDIVR(MA,MB,MC,MD)
      CALL IMEQ(MC,MA)
      CALL IMEQ(MD,MB)
      CALL IMST2M('-626492834178447772323',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDIVR',MA,'MA',MC,'MC')
      ENDIF
      CALL IMST2M('31059777254296217822749494999104',MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDIVR',MB,'MB',MC,'MC')
      ENDIF

      NCASE = 240
      CALL IMST2M('4866',MA)
      CALL IMMPYI(MA,14,ME)
      CALL IMEQ(ME,MA)
      CALL IMST2M('68124',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMMPYI',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 241
      CALL IMST2M('270131469758308600515800801369101559730894',MA)
      CALL IMMPYI(MA,-2895,ME)
      CALL IMEQ(ME,MA)
      CALL IMST2M('-782030604950303398493243319963549015420938130',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMMPYI ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 242
      CALL IMST2M('-37179',MA)
      CALL IMDIVI(MA,129,ME)
      CALL IMEQ(ME,MA)
      CALL IMST2M('-288',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDIVI',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 243
      ST1 = '8267538919383255454483790743961990401918726073065738'
      CALL IMST2M(ST1,MA)
      CALL IMDIVI(MA,1729,ME)
      CALL IMEQ(ME,MA)
      ST2 = '4781688212483085861471249707323302719444028960708'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDIVI',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 244
      CALL IMST2M('-71792',MA)
      CALL IMDVIR(MA,65,MC,IREM)
      CALL IMEQ(MC,MA)
      CALL IMST2M('-1104',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDVIR',MA,'MA',MC,'MC')
      ENDIF
      CALL IMI2M(IREM,MB)
      CALL IMI2M(-32,MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDVIR',MB,'MB',MC,'MC')
      ENDIF

      NCASE = 245
      ST1 = '97813261647284266997658972239417958580120170263408655'
      CALL IMST2M(ST1,MA)
      CALL IMDVIR(MA,826,MC,IREM)
      CALL IMEQ(MC,MA)
      ST2 = '118417992309060855929369215786220288837917881674828'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDVIR',MA,'MA',MC,'MC')
      ENDIF
      CALL IMI2M(IREM,MB)
      CALL IMI2M(727,MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPRTIM('IMDVIR',MB,'MB',MC,'MC')
      ENDIF

      NCASE = 246
      CALL IMST2M('538',MA)
      CALL IMSQR(MA,ME)
      CALL IMEQ(ME,MA)
      CALL IMST2M('289444',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMSQR ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 247
      CALL IMST2M('-47818191879814587168242632',MA)
      CALL IMSQR(MA,ME)
      CALL IMEQ(ME,MA)
      ST2 = '2286579474654765721668058416662636606051551222287424'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMSQR ',MA,'MA',MC,'MC')
      ENDIF

      RETURN
      END SUBROUTINE TEST12

      SUBROUTINE TEST13

!  Test conversions between FM and IM format.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing conversions between FM and IM format.')")

      NCASE = 248
      CALL IMST2M('123',MA)
      CALL IMI2FM(MA,MB)
      CALL FMI2M(123,MC)
      CALL FMSUB(MB,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'EQ',MB)) THEN
          CALL ERRPRTFM('IMI2FM',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 249
      CALL IMST2M('979282999076598337488362000995916',MA)
      CALL IMI2FM(MA,MB)
      CALL FMST2M('979282999076598337488362000995916',MC)
      CALL FMSUB(MB,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'EQ',MB)) THEN
          CALL ERRPRTFM('IMI2FM',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 250
      CALL FMST2M('123.4',MA)
      CALL IMFM2I(MA,MB)
      CALL IMI2M(123,MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPRTIM('IMFM2I',MB,'MB',MC,'MC')
      ENDIF

      NCASE = 251
      CALL FMST2M('979282999076598337488362000995916',MA)
      CALL IMFM2I(MA,MB)
      CALL IMST2M('979282999076598337488362000995916',MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPRTIM('IMFM2I',MB,'MB',MC,'MC')
      ENDIF

      RETURN
      END SUBROUTINE TEST13

      SUBROUTINE TEST14

!  Test integer power and GCD functions.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing integer GCD and power routines.')")

      NCASE = 252
      CALL IMST2M('123',MA)
      CALL IMST2M('789',MB)
      CALL IMGCD(MA,MB,ME)
      CALL IMEQ(ME,MA)
      CALL IMI2M(3,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMGCD ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 253
      ST1 = '431134020618556701030927835051546391752577319587628885'
      CALL IMST2M(ST1,MA)
      ST1 = '900309278350515463917525773195876288659793814432989640'
      CALL IMST2M(ST1,MB)
      CALL IMGCD(MA,MB,ME)
      CALL IMEQ(ME,MA)
      CALL IMST2M('615',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMGCD ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 254
      ST1 = '5877631675869176172956662762822298812326084745145447940'
      CALL IMST2M(ST1,MA)
      ST1 = '10379997509886032090765062511740075746391432253007667'
      CALL IMST2M(ST1,MB)
      CALL IMGCD(MA,MB,ME)
      CALL IMEQ(ME,MA)
      CALL IMST2M('1',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMGCD ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 255
      CALL IMST2M('47',MA)
      CALL IMST2M('34',MB)
      CALL IMPOWER(MA,MB,ME)
      CALL IMEQ(ME,MA)
      ST2 = '710112520079088427392020925014421733344154169313556279969'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMPWR ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 256
      CALL IMST2M('2',MA)
      CALL IMST2M('187',MB)
      CALL IMPOWER(MA,MB,ME)
      CALL IMEQ(ME,MA)
      ST2 = '196159429230833773869868419475239575503198607639501078528'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMPWR ',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 257
      CALL IMST2M('-3',MA)
      CALL IMST2M('101',MB)
      CALL IMPOWER(MA,MB,ME)
      CALL IMEQ(ME,MA)
      ST2 = '-1546132562196033993109383389296863818106322566003'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMPWR ',MA,'MA',MC,'MC')
      ENDIF

      RETURN
      END SUBROUTINE TEST14

      SUBROUTINE TEST15

!  Test integer modular functions.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing integer modular routines.')")

      NCASE = 258
      CALL IMST2M('123',MA)
      CALL IMST2M('789',MB)
      CALL IMST2M('997',MC)
      CALL IMMPY_MOD(MA,MB,MC,ME)
      CALL IMEQ(ME,MA)
      CALL IMI2M(338,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMMPYM',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 259
      ST1 = '431134020618556701030927835051546391752577319587628885'
      CALL IMST2M(ST1,MA)
      ST1 = '36346366019557973241042306587666640486264616086971724'
      CALL IMST2M(ST1,MB)
      ST1 = '900309278350515463917525773195876288659793814432989640'
      CALL IMST2M(ST1,MC)
      CALL IMMPY_MOD(MA,MB,MC,ME)
      CALL IMEQ(ME,MA)
      ST2 = '458279704440780378752997531208983184411293504187816380'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMMPYM',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 260
      ST1 = '914726194238000125985765939883182'
      CALL IMST2M(ST1,MA)
      ST1 = '-75505764717193044779376979508186553225192'
      CALL IMST2M(ST1,MB)
      ST1 = '18678872625055834600521936'
      CALL IMST2M(ST1,MC)
      CALL IMMPY_MOD(MA,MB,MC,ME)
      CALL IMEQ(ME,MA)
      ST2 = '-7769745969769966093344960'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMMPYM',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 261
      CALL IMST2M('123',MA)
      CALL IMST2M('789',MB)
      CALL IMST2M('997',MC)
      CALL IMPOWER_MOD(MA,MB,MC,ME)
      CALL IMEQ(ME,MA)
      CALL IMI2M(240,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMPMOD',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 262
      ST1 = '431134020618556701030927835051546391752577319587628885'
      CALL IMST2M(ST1,MA)
      ST1 = '36346366019557973241042306587666640486264616086971724'
      CALL IMST2M(ST1,MB)
      ST1 = '900309278350515463917525773195876288659793814432989640'
      CALL IMST2M(ST1,MC)
      CALL IMPOWER_MOD(MA,MB,MC,ME)
      CALL IMEQ(ME,MA)
      ST2 = '755107893576299697276281907390144058060594744720442385'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMPMOD',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 263
      CALL IMST2M('314159',MA)
      CALL IMST2M('1411695892374393248272691827763664225585897550',MB)
      CALL IMST2M('1411695892374393248272691827763664225585897551',MC)
      CALL IMPOWER_MOD(MA,MB,MC,ME)
      CALL IMEQ(ME,MA)
      CALL IMST2M('1',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMPMOD',MA,'MA',MC,'MC')
      ENDIF

      RETURN
      END SUBROUTINE TEST15

      SUBROUTINE TEST16

!  Complex input and output testing.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing complex input and output routines.')")

      NCASE = 264
      CALL ZMST2M('123 + 456 i',ZA)
      CALL ZM2I2M(123,456,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-48,ME)
      CALL FMEQ(ME,MB)

!             Use the .NOT. because FMCOMP returns FALSE for special cases like ZD = UNKNOWN,
!             and these should be treated as errors for these tests.

      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMST2M',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 265
      STZ1 = '0.3505154639175257731958762886597938144329896907216495 + '  &
         // '0.7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZM2I2M(34,71,ZC)
      CALL ZMDIVI(ZC,97,ZE)
      CALL ZMEQ(ZE,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMST2M',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 266
      STZ1 = '0.3505154639175257731958762886597938144329896907216495E-5 '  &
       //'+ 0.7319587628865979381443298969072164948453608247422680D-5 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZM2I2M(34,71,ZC)
      CALL ZMDIVI(ZC,9700000,ZE)
      CALL ZMEQ(ZE,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-55,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMST2M',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 267
      STZ1 = '7.699115044247787610619469026548672566371681415929204e 03 '  &
       //'- 5.221238938053097345132743362831858407079646017699115M 03 I'
      CALL ZMST2M(STZ1,ZA)
      CALL ZM2I2M(87,-59,ZC)
      CALL ZMDIVI(ZC,113,ZE)
      CALL ZMEQ(ZE,ZC)
      CALL ZMMPYI(ZC,10000,ZE)
      CALL ZMEQU(ZE,ZC,NDIG,NDIG)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-47,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMST2M',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 268
      STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 '  &
       //'- 5.221238938053097345132743362831858407079646017699115M+3 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMFORM('F53.33','F50.30',ZA,STZ2)
      CALL ZMST2M(STZ2,ZA)
      STZ1 = '7699.115044247787610619469026548673 '  &
       // '-5221.238938053097345132743362831858 i'
      CALL ZMST2M(STZ1,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-30,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMFORM',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 269
      STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 '  &
       //'- 5.221238938053097345132743362831858407079646017699115M+3 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMFORM('I9','I7',ZA,STZ2)
      CALL ZMST2M(STZ2,ZA)
      STZ1 = '7699 -5221 i'
      CALL ZMST2M(STZ1,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(0,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMFORM',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 270
      STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 '  &
       //'- 5.221238938053097345132743362831858407079646017699115M+3 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMFORM('E59.50','E58.49',ZA,STZ2)
      CALL ZMST2M(STZ2,ZA)
      STZ1 = '7.6991150442477876106194690265486725663716814159292E3'  &
       //'- 5.221238938053097345132743362831858407079646017699E3 i'
      CALL ZMST2M(STZ1,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-48,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMFORM',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 271
      STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 '  &
       //'- 5.221238938053097345132743362831858407079646017699115M+3 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMFORM('ES59.50','ES58.49',ZA,STZ2)
      CALL ZMST2M(STZ2,ZA)
      CALL ZMST2M(STZ1,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-44,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMFORM',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 272
      STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 '  &
       //'- 5.221238938053097345132743362831858407079646017699115M+3 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMFORM('ES59.50','ES58.49',ZA,STZ2)
      CALL ZMST2M(STZ2,ZA)
      CALL ZMST2M(STZ1,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-44,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMFORM',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      RETURN
      END SUBROUTINE TEST16

      SUBROUTINE TEST17

!  Test complex add and subtract.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing complex add and subtract routines.')")

      NCASE = 273
      CALL ZMST2M('123 + 456 i',ZA)
      CALL ZMST2M('789 - 543 i',ZB)
      CALL ZMADD(ZA,ZB,ZE)
      CALL ZMEQ(ZE,ZA)
      CALL ZM2I2M(912,-87,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(0,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMADD ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 274
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      STZ1 = '.3505154639175257731958762886597938144329896907216495 '  &
       //'+ .7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZB)
      CALL ZMADD(ZA,ZB,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '1.1204269683423045342578231913146610710701578323145698 '  &
       //'+ 0.2098348690812882036310555606240306541373962229723565 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMADD ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 275
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      STZ1 = '.3505154639175257731958762886597938144329896907216495 '  &
       //'+ .7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZB)
      CALL ZMSUB(ZA,ZB,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.4193960405072529878660706139950734422041784508712709 '  &
       //'- 1.2540826566919076726576042331904023355533254265121795 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMSUB ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 276
      STZ1 = '.7699115044247787610619469026548672566371681415929204E3 '  &
       //'- .5221238938053097345132743362831858407079646017699115E3 i'
      CALL ZMST2M(STZ1,ZA)
      STZ1 = '.3505154639175257731958762886597938144329896907216495 '  &
       //'+ .7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZB)
      CALL ZMSUB(ZA,ZB,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '769.5609889608612352887510263662074628227351519021987045 '  &
       //'- 522.8558525681963324514186661800930572028099625946537725 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-47,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMSUB ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      RETURN
      END SUBROUTINE TEST17

      SUBROUTINE TEST18

!  Test complex multiply, divide and square root.

      IMPLICIT NONE

      WRITE (KW, "(/' Testing complex multiply, divide and square root routines.')")

      NCASE = 277
      CALL ZMST2M('123 + 456 i',ZA)
      CALL ZMST2M('789 - 543 i',ZB)
      CALL ZMMPY(ZA,ZB,ZE)
      CALL ZMEQ(ZE,ZA)
      CALL ZM2I2M(344655,292995,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(0,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMMPY ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 278
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      STZ1 = '.3505154639175257731958762886597938144329896907216495 '  &
       //'+ .7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZB)
      CALL ZMMPY(ZA,ZB,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.6520390475321594745005017790347596022260742632971444 '  &
       //'+ 0.3805309734513274336283185840707964601769911504424779 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMMPY ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 279
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      STZ1 = '.3505154639175257731958762886597938144329896907216495 '  &
       //'+ .7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZB)
      CALL ZMDIV(ZA,ZB,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '-.1705178497731560089737969128653459210208765017614861 '  &
       //'- 1.1335073636829696356072949942949842987114804337239972 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMDIV ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 280
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMMPYI(ZA,36,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '27.7168141592920353982300884955752212389380530973451327 '  &
       //'- 18.7964601769911504424778761061946902654867256637168142 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-48,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMMPYI',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 281
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMDIVI(ZA,37,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '2.080841903850753408275532169337479071992346328629514E-2 '  &
       //'- 1.411145658933269552738579287251853623535039464243004E-2 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-52,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMDIVI',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 282
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMSQR(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.3201503641632077688150990680554467851828647505677813 '  &
       //'- 0.8039783851515388832328295089670295246299631921058814 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMSQR ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 283
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMSQRT(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.9219999909012323458336720551458583330580388434229845 '  &
       //'- 0.2831474506279259570386845864488094697732718981999941 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMSQRT',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      RETURN
      END SUBROUTINE TEST18

      SUBROUTINE TEST19

!  Test complex exponentials.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing complex exponential routines.')")

      NCASE = 284
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMEXP(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '1.8718374504057787925867989348073888855260008469310002 '  &
       //'- 1.0770279996847678711699041910427261417963102075889234 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMEXP ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 285
      STZ1 = '5.7699115044247787610619469026548672566371681415929204 '  &
       //'- 4.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMEXP(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '-60.6144766542152809520229386164396710991242264070603612 '  &
       //'+ 314.7254994809539691403004121118801578835669635535466592 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-47,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMEXP ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 286
      STZ1 = '1.7699115044247787610619469026548672566371681415929204 '  &
       //'- 1.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMIPOWER(ZA,45,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '31595668743300099.70429472191424818167262151605608585179 '  &
       //'- 19209634448276799.67717448173630165852744930837930753788 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-33,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMIPWR',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 287
      STZ1 = '1.7699115044247787610619469026548672566371681415929204 '  &
       //'- 1.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMIPOWER(ZA,-122,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '3.1000215641022021714480000129414241564868699479432E-46 '  &
       //'- 1.1687846789859477815450163510927243367234863123667E-45 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-93,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMIPWR',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 288
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      STZ1 = '.3505154639175257731958762886597938144329896907216495 '  &
       //'+ .7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZB)
      CALL ZMPOWER(ZA,ZB,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '1.4567089343012352449621841355636496276866203747888724 '  &
       //'- 0.3903177712261966292764255714390622205129978923650749 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMPWR ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 289
      STZ1 = '.3505154639175257731958762886597938144329896907216495 '  &
       //'+ .7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZA)
      STZ1 = '2.7699115044247787610619469026548672566371681415929204 '  &
       //'- 0.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZB)
      CALL ZMPOWER(ZA,ZB,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '-1.0053105716678380336247948739245187868180079734997482 '  &
       // '- 0.0819537653234704467729051473979237153087038930127116 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMPWR ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 290
      STZ1 = '0.7699115044247787610619469026548672566371681415929204 '  &
       //'- 0.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMRATIONAL_POWER(ZA,2,7,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.9653921326136512316639621651337975772631340364271270 '  &
       //'- 0.1659768285667051396562270035411852432430188906482848 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMRPWR',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 291
      STZ1 = '0.7699115044247787610619469026548672566371681415929204 '  &
       //'- 0.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMRATIONAL_POWER(ZA,-19,7,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '-0.0567985880053556315170006800325686036902111276420647 '  &
       // '+ 1.2154793972711356706410882510363594270389067962568571 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMRPWR',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      RETURN
      END SUBROUTINE TEST19

      SUBROUTINE TEST20

!  Test complex logarithms.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing complex logarithm routines.')")

      NCASE = 292
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMLN(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '-0.0722949652393911311212450699415231782692434885813725 '  &
       //'-  0.5959180055163009910007765127008371205749515965219804 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMLN  ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 293
      STZ1 = '.7699115044247787610619469026548672566371681415929204E28 '  &
       //'- .5221238938053097345132743362831858407079646017699115E28 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMLN(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '64.4000876385938880213825156612206746345615981930242708 '  &
       //'-  0.5959180055163009910007765127008371205749515965219804 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-48,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMLN  ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 294
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMLOG10(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '-0.0313973044728549715287589498363619677438302809470943 '  &
       //'-  0.2588039014625211035392823012785304771809982053965284 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMLG10',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 295
      STZ1 = '.7699115044247787610619469026548672566371681415929204E82 '  &
       //'- .5221238938053097345132743362831858407079646017699115E82 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMLOG10(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '81.9686026955271450284712410501636380322561697190529057 '  &
       //'-  0.2588039014625211035392823012785304771809982053965284 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-48,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMLG10',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      RETURN
      END SUBROUTINE TEST20

      SUBROUTINE TEST21

!  Test complex trigonometric functions.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing complex trigonometric routines.')")

      NCASE = 296
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMCOS(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.8180802525254482451348613286211514555816444253416895 '  &
       //'+  0.3801751200076938035500853542125525088505055292851393 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMCOS ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 297
      STZ1 = '34.7699115044247787610619469026548672566371681415929204 '  &
       //'- 42.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMCOS(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '-1432925478410268113.5816466154230974355002592549420099 '  &
       //'-  309002816679456015.00151246245263842483282458519462258 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-31,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMCOS ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 298
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMSIN(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.7931260548991613428648822413402447097755865697557818 '  &
       //'-  0.3921366045897070762848927655743167937790944353110710 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMSIN ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 299
      STZ1 = '34.7699115044247787610619469026548672566371681415929204 '  &
       //'- 42.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMSIN(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '-3.090028166794560150015124624526384249047272360765358E17 '  &
       //'+  1.432925478410268113581646615423097435166828182950161E18 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-31,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMSIN ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 300
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMTAN(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.6141156219447569167198437040270236055089243090199979 '  &
       //'-  0.7647270337230070156308196055474639461102792169274526 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMTAN ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 301
      STZ1 = '35.7699115044247787610619469026548672566371681415929204 '  &
       //'- 43.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMTAN(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '2.068934241218867332441292427642153175237611151321340E-38 '  &
       //'-  1.000000000000000000000000000000000000023741659169354 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMTAN ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 302
      STZ1 = '0.3505154639175257731958762886597938144329896907216495 '  &
       //'+  0.7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMCOS_SIN(ZA,ZE,ZC)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '1.2022247452809115256533054407001508718694617802593324 '  &
       //'-  0.2743936538120352873902095801531325075994392065668943 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMCSSN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 303
      STZ1 = '0.3505154639175257731958762886597938144329896907216495 '  &
       //'+  0.7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMCOS_SIN(ZA,ZC,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.4395486978082638069281369170831952476351663772871008 '  &
       //'+  0.7505035100906417134864779281080728222900154610025883 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMCSSN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      RETURN
      END SUBROUTINE TEST21

      SUBROUTINE TEST22

!  Test complex inverse trigonometric functions.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing complex inverse trigonometric routines.')")

      NCASE = 304
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMACOS(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.8797127900868121872960714368309657795959216549012347 '  &
       //'+  0.6342141347945396859119941874681961111936156338608130 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMACOS',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 305
      STZ1 = '.7699115044247787610619469026548672566371681415929204E12 '  &
       //'- .5221238938053097345132743362831858407079646017699115E12 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMACOS(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.5959180055163009910007767810953294528367807973983794 '  &
       //'+28.2518733312491023865118844008522768856672089946951468 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-48,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMACOS',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 306
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMASIN(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.6910835367080844319352502548087856625026630447863182 '  &
       //'-  0.6342141347945396859119941874681961111936156338608130 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMASIN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 307
      STZ1 = '.7699115044247787610619469026548672566371681415929204E13 '  &
       //'- .5221238938053097345132743362831858407079646017699115E13 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMASIN(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.9748783212785956282305451762549693982010148111568094 '  &
       //'-30.5544584242431480705298759613446206186670533428066404 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-48,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMASIN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 308
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMATAN(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.7417952692265900376512911713942700568648670953521258 '  &
       //'- 0.3162747143126729004878357203292329539837025170484857 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMATAN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 309
      STZ1 = '.7699115044247787610619469026548672566371681415929204E13 '  &
       //'- .5221238938053097345132743362831858407079646017699115E13 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMATAN(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '   1.570796326794807650905529836436131532596233124329403 '  &
       //'-6.033484162895927601809954710695221401671437742867605E-14 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMATAN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      RETURN
      END SUBROUTINE TEST22

      SUBROUTINE TEST23

!  Test complex hyperbolic functions.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing complex hyperbolic routines.')")

      NCASE = 310
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMCOSH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '1.1365975275870879962259716562608779977957563621412079 '  &
       //'-  0.4230463404769118342540441830446134405410543954181579 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMCOSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 311
      STZ1 = '34.7699115044247787610619469026548672566371681415929204 '  &
       //'- 42.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMCOSH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '69552104658681.7558589320148420094288419217262200765435 '  &
       //'+ 626163773308016.884007302915197616300902876551542156676 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-35,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMCOSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 312
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMSINH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.7352399228186907963608272785465108877302444847897922 '  &
       //'-  0.6539816592078560369158600079981127012552558121707655 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMSINH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 313
      STZ1 = '34.7699115044247787610619469026548672566371681415929204 '  &
       //'- 42.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMSINH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '6.955210465868175585893201484192181376093291191637290E 13 '  &
       //'+ 6.261637733080168840073029151984050820616907795167046E 14 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-35,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMSINH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 314
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMTANH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.7562684782933185240709480231996041186654551038993505 '  &
       //'-  0.2938991498221693198532255749292372853685311106820169 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMTANH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 315
      STZ1 = '35.7699115044247787610619469026548672566371681415929204 '  &
       //'- 43.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMTANH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '9.999999999999999999999999999998967653135180689424497E-01 '  &
       //'+ 1.356718776492102400812550018433337461876455254467192E-31 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMTANH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 316
      STZ1 = '0.3505154639175257731958762886597938144329896907216495 '  &
       //'+  0.7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMCOSH_SINH(ZA,ZE,ZC)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.7900326499280864816444807620997665088044412803737969 '  &
       //'+ 0.2390857359988804105051429301542214823277594407302781 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMCHSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 317
      STZ1 = '0.3505154639175257731958762886597938144329896907216495 '  &
       //'+  0.7319587628865979381443298969072164948453608247422680 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMCOSH_SINH(ZA,ZC,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.2661087555034471983220879532235334422670297141428191 '  &
       //'+  0.7098057980612199357870532628105009808447460332437714 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMCHSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 318
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMACOSH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.634214134794539685911994187468196111193615633860813063047 '  &
       //'-  0.87971279008681218729607143683096577959592165490123465108 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-49,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMACSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 319
      STZ1 = '34.7699115044247787610619469026548672566371681415929204 '  &
       //'- 42.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMACOSH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '4.699185653622843767611457701582029888318689701142758455168 '  &
       //'- 0.885442754109270451471936961636924153661585344251816314058 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMACSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 320
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'- .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMASINH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.7635704534445900566191751364753322249524141520884576620460 '  &
       //'-  0.411298860099453379668803021308606607271465469022684432234 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMASNH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 321
      STZ1 = '34.7699115044247787610619469026548672566371681415929204 '  &
       //'- 42.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMASINH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '4.699152741387944521329007830079827163510121700675738493686583 '  &
       //'- 0.885280331861437309635169786543313944594109728905497480903944 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMASNH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 322
      STZ1 = '.7699115044247787610619469026548672566371681415929204 '  &
       //'+ .5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMATANH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.586882600199517579230023110103093954108604678368770838853566 '  &
       //'+  0.72129247131145073405158274968147799882646114519254182360306 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMATNH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      NCASE = 323
      STZ1 = '35.7699115044247787610619469026548672566371681415929204 '  &
       //'+ 43.5221238938053097345132743362831858407079646017699115 i'
      CALL ZMST2M(STZ1,ZA)
      CALL ZMATANH(ZA,ZE)
      CALL ZMEQ(ZE,ZA)
      STZ2 = '0.01126922171563683586812930494404043654068908857617619358696482 '  &
       //'+ 1.5570819093480669764576964089576282282995266513998725538932609 i'
      CALL ZMST2M(STZ2,ZC)
      CALL ZMSUB(ZA,ZC,ZD)
      CALL ZMABS(ZD,MA)
      CALL FMI2M(10,MB)
      CALL FMIPOWER(MB,-50,ME)
      CALL FMEQ(ME,MB)
      IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
          CALL ERRPRTZM('ZMATNH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
      ENDIF

      RETURN
      END SUBROUTINE TEST23

      SUBROUTINE TEST24

!             Test the = assignment interface.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type = interface.')")

      RSMALL = EPSILON(1.0)*100.0
      DSMALL = EPSILON(1.0D0)*100.0
      MSMALL = EPSILON(TO_FM(1))*10000.0
      NCASE = 324
      J4 = MFM1
      IF (J4 /= 581) CALL PRTERR(KW)

      NCASE = 325
      J4 = MIM1
      IF (J4 /= 661) CALL PRTERR(KW)

      NCASE = 326
      J4 = MZM1
      IF (J4 /= 731) CALL PRTERR(KW)

      NCASE = 327
      R4 = MFM1
      IF (ABS((R4-581.21)/581.21) > RSMALL) CALL PRTERR(KW)

      NCASE = 328
      R4 = MIM1
      IF (ABS((R4-661.0)/661.0) > RSMALL) CALL PRTERR(KW)

      NCASE = 329
      R4 = MZM1
      IF (ABS((R4-731.51)/731.51) > RSMALL) CALL PRTERR(KW)

      NCASE = 330
      D4 = MFM1
      IF (ABS((D4-581.21D0)/581.21D0) > DSMALL) CALL PRTERR(KW)

      NCASE = 331
      D4 = MIM1
      IF (ABS((D4-661.0D0)/661.0D0) > DSMALL) CALL PRTERR(KW)

      NCASE = 332
      D4 = MZM1
      IF (ABS((D4-731.51D0)/731.51D0) > DSMALL) CALL PRTERR(KW)

      NCASE = 333
      C4 = MFM1
      IF (ABS((C4-581.21)/581.21) > RSMALL) CALL PRTERR(KW)

      NCASE = 334
      C4 = MIM1
      IF (ABS((C4-661.0)/661.0) > RSMALL) CALL PRTERR(KW)

      NCASE = 335
      C4 = MZM1
      IF (ABS((C4-(731.51,711.41))/(731.51,711.41)) > RSMALL) CALL PRTERR(KW)

      NCASE = 336
      CD4 = MFM1
      IF (ABS((CD4-581.21D0)/581.21D0) > DSMALL) CALL PRTERR(KW)

      NCASE = 337
      CD4 = MIM1
      IF (ABS((CD4-661.0D0)/661.0D0) > DSMALL) CALL PRTERR(KW)

      NCASE = 338
      CD4 = MZM1
      IF (ABS((CD4-(731.51D0,711.41D0))/(731.51D0,711.41D0)) > DSMALL) CALL PRTERR(KW)

      NCASE = 339
      MFM3 = J2
      CALL FM_I2M(131,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ST2M('0',MFM3)
      IF (FM_COMPARE(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 340
      MFM3 = J2
      CALL FM_I2M(131,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQU(MFM6,MFM4,NDIG,NDIG)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQU(MFM6,MFM4,NDIG,NDIG)
      CALL FM_ST2M('0',MFM3)
      IF (FM_COMPARE(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 341
      MFM3 = J2
      CALL FM_I2M(131,MFM4)
      CALL FM_SUB_R2(MFM3,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQU(MFM6,MFM4,NDIG,NDIG)
      CALL FM_ST2M('0',MFM3)
      IF (FM_COMPARE(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 342
      MFM3 = J2
      CALL FM_I2M(131,MFM4)
      CALL FM_EQU(MFM3,MFM6,NDIG,NDIG)
      CALL FM_SUB_R1(MFM6,MFM4)
      CALL FM_EQU(MFM6,MFM4,NDIG,NDIG)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQU_R1(MFM6,NDIG,NDIG)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ST2M('0',MFM3)
      IF (FM_COMPARE(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 343
      MFM3 = R2
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = RSMALL
      IF (FM_COMPARE(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 344
      MFM3 = D2
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = DSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 345
      MFM3 = C2
      CALL FM_ST2M('411.11',MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = RSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 346
      MFM3 = CD2
      CALL FM_ST2M('431.11',MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = DSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 347
      MFM3 = MFM1
      CALL FM_ST2M('581.21',MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_EQ(MSMALL,MFM3)
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 348
      MFM3 = MIM1
      CALL FM_ST2M('661',MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ST2M('0',MFM3)
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 349
      MFM3 = MZM1
      CALL FM_ST2M('731.51',MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = MSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 350
      MIM3 = J2
      CALL IM_I2M(131,MIM4)
      CALL IM_SUB(MIM3,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      CALL IM_ST2M('0',MIM3)
      IF (IM_COMPARE(MIM4,'GT',MIM3)) CALL PRTERR(KW)

      NCASE = 351
      MIM3 = R2
      CALL IM_ST2M('241',MIM4)
      CALL IM_SUB(MIM3,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      CALL IM_ST2M('0',MIM3)
      IF (IM_COMPARE(MIM4,'GT',MIM3)) CALL PRTERR(KW)

      NCASE = 352
      MIM3 = D2
      CALL IM_ST2M('391',MIM4)
      CALL IM_SUB(MIM3,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      CALL IM_ST2M('0',MIM3)
      IF (IM_COMPARE(MIM4,'GT',MIM3)) CALL PRTERR(KW)

      NCASE = 353
      MIM3 = C2
      CALL IM_ST2M('411',MIM4)
      CALL IM_SUB(MIM3,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      CALL IM_ST2M('0',MIM3)
      IF (IM_COMPARE(MIM4,'GT',MIM3)) CALL PRTERR(KW)

      NCASE = 354
      MIM3 = CD2
      CALL IM_ST2M('431',MIM4)
      CALL IM_SUB(MIM3,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      CALL IM_ST2M('0',MIM3)
      IF (IM_COMPARE(MIM4,'GT',MIM3)) CALL PRTERR(KW)

      NCASE = 355
      MIM3 = MFM1
      CALL IM_ST2M('581',MIM4)
      CALL IM_SUB(MIM3,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      CALL IM_ST2M('0',MIM3)
      IF (IM_COMP(MIM4,'GT',MIM3)) CALL PRTERR(KW)

      NCASE = 356
      MIM3 = MIM1
      CALL IM_ST2M('661',MIM4)
      CALL IM_SUB(MIM3,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      CALL IM_ST2M('0',MIM3)
      IF (IM_COMP(MIM4,'GT',MIM3)) CALL PRTERR(KW)

      NCASE = 357
      MIM3 = MZM1
      CALL IM_ST2M('731',MIM4)
      CALL IM_SUB(MIM3,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      CALL IM_ST2M('0',MIM3)
      IF (IM_COMP(MIM4,'GT',MIM3)) CALL PRTERR(KW)

      NCASE = 358
      MZM3 = J2
      CALL ZM_I2M(131,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM4)
      CALL FM_ST2M('0',MFM3)
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 359
      MZM3 = R2
      CALL ZM_ST2M('241.21',MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQU(MZM5,MZM4,NDIG,NDIG)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = RSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 360
      MZM3 = D2
      CALL ZM_ST2M('391.61',MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = DSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 361
      MZM3 = C2
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = RSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 362
      MZM3 = CD2
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = DSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 363
      MZM3 = MFM1
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = MSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 364
      MZM3 = MIM1
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM4)
      CALL FM_ST2M('0',MFM3)
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 365
      MZM3 = MZM1
      CALL ZM_ST2M('731.51 + 711.41 i',MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = MSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      END SUBROUTINE TEST24

      SUBROUTINE TEST25

!  Test the derived type == interface.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type == interface.')")

      NCASE = 366
      M_A = 123
      M_B = M_A
      IF (.NOT.FM_COMP(M_A,'==',M_B)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 367
      M_A = 123
      M_B = M_A
      IF (.NOT.FM_COMP(M_A,'EQ',M_B)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 368
      J1 = 123
      M_A = J1
      IF (.NOT.(M_A == J1)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 369
      J1 = 123
      M_A = J1
      IF (.NOT.(J1 == M_A)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 370
      J1 = 123
      M_J = J1
      IF (.NOT.(M_J == J1)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 371
      J1 = 123
      M_J = J1
      IF (.NOT.(J1 == M_J)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 372
      J1 = 123
      M_Z = J1
      IF (.NOT.(M_Z == J1)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 373
      J1 = 123
      M_Z = ( 123.0 , 34.5 )
      IF (M_Z == J1) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 374
      J1 = 123
      M_Z = J1
      IF (.NOT.(J1 == M_Z)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 375
      J1 = 123
      M_Z = ( 123.0 , 34.5 )
      IF (J1 == M_Z) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 376
      R1 = 12.3
      M_A = R1
      IF (.NOT.(M_A == R1)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 377
      R1 = 12.3
      M_A = R1
      IF (.NOT.(R1 == M_A)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 378
      R1 = 123
      M_J = R1
      IF (.NOT.(M_J == R1)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 379
      R1 = 123
      M_J = R1
      IF (.NOT.(R1 == M_J)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 380
      R1 = 12.3
      M_Z = R1
      IF (.NOT.(M_Z == R1)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 381
      R1 = 12.3
      M_Z = R1
      IF (.NOT.(R1 == M_Z)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 382
      D1 = 12.3
      M_A = D1
      IF (.NOT.(M_A == D1)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 383
      D1 = 12.3
      M_A = D1
      IF (.NOT.(D1 == M_A)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 384
      D1 = 123
      M_J = D1
      IF (.NOT.(M_J == D1)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 385
      D1 = 123
      M_J = D1
      IF (.NOT.(D1 == M_J)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 386
      D1 = 12.3
      M_Z = D1
      IF (.NOT.(M_Z == D1)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 387
      D1 = 12.3
      M_Z = D1
      IF (.NOT.(D1 == M_Z)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 388
      C1 = 12.3
      M_A = C1
      IF (.NOT.(M_A == C1)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 389
      C1 = (12.3 , 45.6)
      M_A = C1
      IF (M_A == C1) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 390
      C1 = 12.3
      M_A = C1
      IF (.NOT.(C1 == M_A)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 391
      C1 = (12.3 , 45.6)
      M_A = C1
      IF (C1 == M_A) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 392
      C1 = 123
      M_J = C1
      IF (.NOT.(M_J == C1)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 393
      C1 = (12.3 , 45.6)
      M_J = C1
      IF (M_J == C1) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 394
      C1 = 123
      M_J = C1
      IF (.NOT.(C1 == M_J)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 395
      C1 = (12.3 , 45.6)
      M_J = C1
      IF (C1 == M_J) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 396
      C1 = (12.3 , 45.6)
      M_Z = C1
      IF (.NOT.(M_Z == C1)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 397
      C1 = (12.3 , 45.6)
      M_Z = C1
      IF (.NOT.(C1 == M_Z)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 398
      CD1 = 12.3
      M_A = CD1
      IF (.NOT.(M_A == CD1)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 399
      CD1 = (12.3 , 45.6)
      M_A = CD1
      IF (M_A == CD1) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 400
      CD1 = 12.3
      M_A = CD1
      IF (.NOT.(CD1 == M_A)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 401
      CD1 = (12.3 , 45.6)
      M_A = CD1
      IF (CD1 == M_A) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 402
      CD1 = 123
      M_J = CD1
      IF (.NOT.(M_J == CD1)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 403
      CD1 = (123.0 , 45.6)
      M_J = CD1
      IF (M_J == CD1) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 404
      CD1 = 123
      M_J = CD1
      IF (.NOT.(CD1 == M_J)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 405
      CD1 = (123.0 , 45.6)
      M_J = CD1
      IF (CD1 == M_J) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 406
      CD1 = (12.3 , 45.6)
      M_Z = CD1
      IF (.NOT.(M_Z == CD1)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 407
      CD1 = (12.3 , 45.6)
      M_Z = CD1
      IF (.NOT.(CD1 == M_Z)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 408
      M_B = 12.3
      M_A = M_B
      IF (.NOT.(M_A == M_B)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 409
      M_B = 123
      M_J = M_B
      IF (.NOT.(M_J == M_B)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 410
      M_B = 123.4
      M_J = M_B
      IF (M_J == M_B) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 411
      M_B = 123
      M_J = M_B
      IF (.NOT.(M_B == M_J)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 412
      M_B = 123.4
      M_J = M_B
      IF (M_B == M_J) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 413
      M_B = (12.3 , 45.6)
      M_Z = M_B
      IF (.NOT.(M_Z == M_B)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 414
      M_Z = (12.3 , 45.6)
      M_B = M_Z
      IF (M_Z == M_B) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 415
      M_B = (12.3 , 45.6)
      M_Z = M_B
      IF (.NOT.(M_B == M_Z)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 416
      M_Z = (12.3 , 45.6)
      M_B = M_Z
      IF (M_B == M_Z) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 417
      M_K = 123
      M_J = M_K
      IF (.NOT.(M_J == M_K)) THEN
          CALL ERRPRT_IM('  ==  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 418
      M_K = (12.3 , 45.6)
      M_Z = M_K
      IF (.NOT.(M_Z == M_K)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 419
      M_Z = (12.3 , 45.6)
      M_K = M_Z
      IF (M_Z == M_K) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 420
      M_K = (12.3 , 45.6)
      M_Z = M_K
      IF (.NOT.(M_K == M_Z)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 421
      M_Z = (12.3 , 45.6)
      M_K = M_Z
      IF (M_K == M_Z) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 422
      M_Y = (12.3 , 45.6)
      M_Z = M_Y
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM('  ==  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      RETURN
      END SUBROUTINE TEST25

      SUBROUTINE TEST26

!  Test the derived type /= interface.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type /= interface.')")

      NCASE = 423
      M_A = 123
      M_B = 124
      IF (.NOT.FM_COMP(M_A,'/=',M_B)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 424
      M_A = 123
      M_B = 124
      IF (.NOT.FM_COMP(M_A,'NE',M_B)) THEN
          CALL ERRPRT_FM('  ==  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 425
      J1 = 123
      M_A = 1 + J1
      IF (.NOT.(M_A /= J1)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 426
      J1 = 123
      M_A = 1 + J1
      IF (.NOT.(J1 /= M_A)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 427
      J1 = 123
      M_J = 1 + J1
      IF (.NOT.(M_J /= J1)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 428
      J1 = 123
      M_J = 1 + J1
      IF (.NOT.(J1 /= M_J)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 429
      J1 = 123
      M_Z = 1 + J1
      IF (.NOT.(M_Z /= J1)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 430
      J1 = 123
      M_Z = ( 123.0 , 34.5 )
      IF (.NOT.(M_Z /= J1)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 431
      J1 = 123
      M_Z = 1 + J1
      IF (.NOT.(J1 /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 432
      J1 = 123
      M_Z = ( 123.0 , 34.5 )
      IF (.NOT.(J1 /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 433
      R1 = 12.3
      M_A = 1 + R1
      IF (.NOT.(M_A /= R1)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 434
      R1 = 12.3
      M_A = 1 + R1
      IF (.NOT.(R1 /= M_A)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 435
      R1 = 123
      M_J = 1 + R1
      IF (.NOT.(M_J /= R1)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 436
      R1 = 123
      M_J = 1 + R1
      IF (.NOT.(R1 /= M_J)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 437
      R1 = 12.3
      M_Z = 1 + R1
      IF (.NOT.(M_Z /= R1)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 438
      R1 = 12.3
      M_Z = ( 12.3 , 34.5 )
      IF (.NOT.(M_Z /= R1)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 439
      R1 = 12.3
      M_Z = 1 + R1
      IF (.NOT.(R1 /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 440
      R1 = 12.3
      M_Z = ( 12.3 , 34.5 )
      IF (.NOT.(R1 /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 441
      D1 = 12.3
      M_A = 1 + D1
      IF (.NOT.(M_A /= D1)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 442
      D1 = 12.3
      M_A = 1 + D1
      IF (.NOT.(D1 /= M_A)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 443
      D1 = 123
      M_J = 1 + D1
      IF (.NOT.(M_J /= D1)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 444
      D1 = 123
      M_J = 1 + D1
      IF (.NOT.(D1 /= M_J)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 445
      D1 = 12.3
      M_Z = 1 + D1
      IF (.NOT.(M_Z /= D1)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 446
      D1 = 12.3
      M_Z = ( 12.3 , 34.5 )
      IF (.NOT.(M_Z /= D1)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 447
      D1 = 12.3
      M_Z = 1 + D1
      IF (.NOT.(D1 /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 448
      D1 = 12.3
      M_Z = ( 12.3 , 34.5 )
      IF (.NOT.(D1 /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 449
      C1 = 12.3
      M_A = 1 + C1
      IF (.NOT.(M_A /= C1)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 450
      C1 = ( 12.3 , 34.5 )
      M_A = ( 12.3 , 34.5 )
      IF (.NOT.(M_A /= C1)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 451
      C1 = 12.3
      M_A = 1 + C1
      IF (.NOT.(C1 /= M_A)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 452
      C1 = ( 12.3 , 34.5 )
      M_A = ( 12.3 , 34.5 )
      IF (.NOT.(C1 /= M_A)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 453
      C1 = 123
      M_J = 1 + C1
      IF (.NOT.(M_J /= C1)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 454
      C1 = ( 123.0 , 34.5 )
      M_J = ( 123.0 , 34.5 )
      IF (.NOT.(M_J /= C1)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 455
      C1 = 123
      M_J = 1 + C1
      IF (.NOT.(C1 /= M_J)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 456
      C1 = ( 123.0 , 34.5 )
      M_J = ( 123.0 , 34.5 )
      IF (.NOT.(C1 /= M_J)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 457
      C1 = (12.3 , 45.6)
      M_Z = 1 + C1
      IF (.NOT.(M_Z /= C1)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 458
      C1 = (12.3 , 45.6)
      M_Z = 1 + C1
      IF (.NOT.(C1 /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 459
      CD1 = 12.3
      M_A = 1 + CD1
      IF (.NOT.(M_A /= CD1)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 460
      CD1 = (12.3 , 45.6)
      M_A = (12.3 , 45.6)
      IF (.NOT.(M_A /= CD1)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 461
      CD1 = 12.3
      M_A = 1 + CD1
      IF (.NOT.(CD1 /= M_A)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 462
      CD1 = (12.3 , 45.6)
      M_A = (12.3 , 45.6)
      IF (.NOT.(CD1 /= M_A)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 463
      CD1 = 123
      M_J = 1 + CD1
      IF (.NOT.(M_J /= CD1)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 464
      CD1 = (123.0 , 45.6)
      M_J = (123.0 , 45.6)
      IF (.NOT.(M_J /= CD1)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 465
      CD1 = 123
      M_J = 1 + CD1
      IF (.NOT.(CD1 /= M_J)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 466
      CD1 = (123.0 , 45.6)
      M_J = (123.0 , 45.6)
      IF (.NOT.(CD1 /= M_J)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 467
      CD1 = (12.3 , 45.6)
      M_Z = 1 + CD1
      IF (.NOT.(M_Z /= CD1)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 468
      CD1 = (12.3 , 45.6)
      M_Z = 1 + CD1
      IF (.NOT.(CD1 /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 469
      M_B = 12.3
      M_A = 1 + M_B
      IF (.NOT.(M_A /= M_B)) THEN
          CALL ERRPRT_FM('  /=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 470
      M_B = 123
      M_J = 1 + M_B
      IF (.NOT.(M_J /= M_B)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 471
      M_B = 123.4
      M_J = M_B
      IF (.NOT.(M_J /= M_B)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 472
      M_B = 123
      M_J = 1 + M_B
      IF (.NOT.(M_B /= M_J)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 473
      M_B = 123.4
      M_J = M_B
      IF (.NOT.(M_B /= M_J)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 474
      M_B = (12.3 , 45.6)
      M_Z = 1 + M_B
      IF (.NOT.(M_Z /= M_B)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 475
      M_B = (12.3 , 45.6)
      M_Z = (12.3 , 34.5)
      IF (.NOT.(M_Z /= M_B)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 476
      M_B = (12.3 , 45.6)
      M_Z = 1 + M_B
      IF (.NOT.(M_B /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 477
      M_B = (12.3 , 45.6)
      M_Z = (12.3 , 34.5)
      IF (.NOT.(M_B /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 478
      M_K = 123
      M_J = 1 + M_K
      IF (.NOT.(M_J /= M_K)) THEN
          CALL ERRPRT_IM('  /=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 479
      M_K = (12.3 , 45.6)
      M_Z = 1 + M_K
      IF (.NOT.(M_Z /= M_K)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 480
      M_K = (123.0 , 45.6)
      M_Z = (123.0 , 34.5)
      IF (.NOT.(M_Z /= M_K)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 481
      M_K = (12.3 , 45.6)
      M_Z = 1 + M_K
      IF (.NOT.(M_K /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 482
      M_K = (123.0 , 45.6)
      M_Z = (123.0 , 34.5)
      IF (.NOT.(M_K /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 483
      M_Y = (12.3 , 45.6)
      M_Z = 1 + M_Y
      IF (.NOT.(M_Y /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      NCASE = 484
      M_Y = (12.3 , 45.6)
      M_Z = (12.3 , 34.5)
      IF (.NOT.(M_Y /= M_Z)) THEN
          CALL ERRPRT_ZM('  /=  ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
      ENDIF

      RETURN
      END SUBROUTINE TEST26

      SUBROUTINE TEST27

!  Test the derived type > interface.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type > interface.')")

      NCASE = 485
      M_A = 125
      M_B = 124
      IF (.NOT.FM_COMP(M_A,'>',M_B)) THEN
          CALL ERRPRT_FM('   >  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 486
      M_A = 125
      M_B = 124
      IF (.NOT.FM_COMP(M_A,'GT',M_B)) THEN
          CALL ERRPRT_FM('   >  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 487
      J1 = 123
      M_A = J1 + 1
      IF (.NOT.(M_A > J1)) THEN
          CALL ERRPRT_FM('   >  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 488
      J1 = 123
      M_A = J1 - 1
      IF (.NOT.(J1 > M_A)) THEN
          CALL ERRPRT_FM('   >  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 489
      J1 = 123
      M_J = J1 + 1
      IF (.NOT.(M_J > J1)) THEN
          CALL ERRPRT_IM('   >  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 490
      J1 = 123
      M_J = J1 - 1
      IF (.NOT.(J1 > M_J)) THEN
          CALL ERRPRT_IM('   >  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 491
      R1 = 12.3
      M_A = R1 + 1
      IF (.NOT.(M_A > R1)) THEN
          CALL ERRPRT_FM('   >  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 492
      R1 = 12.3
      M_A = R1 - 1
      IF (.NOT.(R1 > M_A)) THEN
          CALL ERRPRT_FM('   >  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 493
      R1 = 123
      M_J = R1 + 1
      IF (.NOT.(M_J > R1)) THEN
          CALL ERRPRT_IM('   >  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 494
      R1 = 123
      M_J = R1 - 1
      IF (.NOT.(R1 > M_J)) THEN
          CALL ERRPRT_IM('   >  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 495
      D1 = 12.3
      M_A = D1 + 1
      IF (.NOT.(M_A > D1)) THEN
          CALL ERRPRT_FM('   >  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 496
      D1 = 12.3
      M_A = D1 - 1
      IF (.NOT.(D1 > M_A)) THEN
          CALL ERRPRT_FM('   >  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 497
      D1 = 123
      M_J = D1 + 1
      IF (.NOT.(M_J > D1)) THEN
          CALL ERRPRT_IM('   >  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 498
      D1 = 123
      M_J = D1 - 1
      IF (.NOT.(D1 > M_J)) THEN
          CALL ERRPRT_IM('   >  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 499
      M_B = 12.3
      M_A = M_B + 1
      IF (.NOT.(M_A > M_B)) THEN
          CALL ERRPRT_FM('   >  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 500
      M_B = 123
      M_J = M_B + 1
      IF (.NOT.(M_J > M_B)) THEN
          CALL ERRPRT_IM('   >  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 501
      M_B = 123
      M_J = M_B - 1
      IF (.NOT.(M_B > M_J)) THEN
          CALL ERRPRT_IM('   >  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 502
      M_K = 123
      M_J = M_K + 1
      IF (.NOT.(M_J > M_K)) THEN
          CALL ERRPRT_IM('   >  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      RETURN
      END SUBROUTINE TEST27

      SUBROUTINE TEST28

!  Test the derived type >= interface.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type >= interface.')")

      NCASE = 503
      M_A = 125
      M_B = 124
      IF (.NOT.FM_COMP(M_A,'>=',M_B)) THEN
          CALL ERRPRT_FM('  >=  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 504
      M_A = 125
      M_B = 124
      IF (.NOT.FM_COMP(M_A,'GE',M_B)) THEN
          CALL ERRPRT_FM('  >=  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 505
      J1 = 123
      M_A = J1 + 1
      IF (.NOT.(M_A >= J1)) THEN
          CALL ERRPRT_FM('  >=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 506
      J1 = 123
      M_A = J1 - 1
      IF (.NOT.(J1 >= M_A)) THEN
          CALL ERRPRT_FM('  >=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 507
      J1 = 123
      M_J = J1 + 1
      IF (.NOT.(M_J >= J1)) THEN
          CALL ERRPRT_IM('  >=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 508
      J1 = 123
      M_J = J1 - 1
      IF (.NOT.(J1 >= M_J)) THEN
          CALL ERRPRT_IM('  >=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 509
      R1 = 12.3
      M_A = R1 + 1
      IF (.NOT.(M_A >= R1)) THEN
          CALL ERRPRT_FM('  >=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 510
      R1 = 12.3
      M_A = R1 - 1
      IF (.NOT.(R1 >= M_A)) THEN
          CALL ERRPRT_FM('  >=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 511
      R1 = 123
      M_J = R1 + 1
      IF (.NOT.(M_J >= R1)) THEN
          CALL ERRPRT_IM('  >=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 512
      R1 = 123
      M_J = R1 - 1
      IF (.NOT.(R1 >= M_J)) THEN
          CALL ERRPRT_IM('  >=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 513
      D1 = 12.3
      M_A = D1 + 1
      IF (.NOT.(M_A >= D1)) THEN
          CALL ERRPRT_FM('  >=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 514
      D1 = 12.3
      M_A = D1 - 1
      IF (.NOT.(D1 >= M_A)) THEN
          CALL ERRPRT_FM('  >=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 515
      D1 = 123
      M_J = D1 + 1
      IF (.NOT.(M_J >= D1)) THEN
          CALL ERRPRT_IM('  >=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 516
      D1 = 123
      M_J = D1 - 1
      IF (.NOT.(D1 >= M_J)) THEN
          CALL ERRPRT_IM('  >=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 517
      M_B = 12.3
      M_A = M_B + 1
      IF (.NOT.(M_A >= M_B)) THEN
          CALL ERRPRT_FM('  >=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 518
      M_B = 123
      M_J = M_B + 1
      IF (.NOT.(M_J >= M_B)) THEN
          CALL ERRPRT_IM('  >=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 519
      M_B = 123
      M_J = M_B - 1
      IF (.NOT.(M_B >= M_J)) THEN
          CALL ERRPRT_IM('  >=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 520
      M_K = 123
      M_J = M_K + 1
      IF (.NOT.(M_J >= M_K)) THEN
          CALL ERRPRT_IM('  >=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      RETURN
      END SUBROUTINE TEST28

      SUBROUTINE TEST29

!  Test the derived type < interface.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type < interface.')")

      NCASE = 521
      M_A = 123
      M_B = 124
      IF (.NOT.FM_COMP(M_A,'<',M_B)) THEN
          CALL ERRPRT_FM('   <  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 522
      M_A = 123
      M_B = 124
      IF (.NOT.FM_COMP(M_A,'LT',M_B)) THEN
          CALL ERRPRT_FM('   <  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 523
      J1 = 123
      M_A = J1 - 2
      IF (.NOT.(M_A < J1)) THEN
          CALL ERRPRT_FM('   <  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 524
      J1 = 123
      M_A = J1 + 2
      IF (.NOT.(J1 < M_A)) THEN
          CALL ERRPRT_FM('   <  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 525
      J1 = 123
      M_J = J1 - 2
      IF (.NOT.(M_J < J1)) THEN
          CALL ERRPRT_IM('   <  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 526
      J1 = 123
      M_J = J1 + 2
      IF (.NOT.(J1 < M_J)) THEN
          CALL ERRPRT_IM('   <  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 527
      R1 = 12.3
      M_A = R1 - 2
      IF (.NOT.(M_A < R1)) THEN
          CALL ERRPRT_FM('   <  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 528
      R1 = 12.3
      M_A = R1 + 2
      IF (.NOT.(R1 < M_A)) THEN
          CALL ERRPRT_FM('   <  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 529
      R1 = 123
      M_J = R1 - 2
      IF (.NOT.(M_J < R1)) THEN
          CALL ERRPRT_IM('   <  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 530
      R1 = 123
      M_J = R1 + 2
      IF (.NOT.(R1 < M_J)) THEN
          CALL ERRPRT_IM('   <  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 531
      D1 = 12.3
      M_A = D1 - 2
      IF (.NOT.(M_A < D1)) THEN
          CALL ERRPRT_FM('   <  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 532
      D1 = 12.3
      M_A = D1 + 2
      IF (.NOT.(D1 < M_A)) THEN
          CALL ERRPRT_FM('   <  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 533
      D1 = 123
      M_J = D1 - 2
      IF (.NOT.(M_J < D1)) THEN
          CALL ERRPRT_IM('   <  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 534
      D1 = 123
      M_J = D1 + 2
      IF (.NOT.(D1 < M_J)) THEN
          CALL ERRPRT_IM('   <  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 535
      M_B = 12.3
      M_A = M_B - 2
      IF (.NOT.(M_A < M_B)) THEN
          CALL ERRPRT_FM('   <  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 536
      M_B = 123
      M_J = M_B - 2
      IF (.NOT.(M_J < M_B)) THEN
          CALL ERRPRT_IM('   <  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 537
      M_B = 123
      M_J = M_B + 2
      IF (.NOT.(M_B < M_J)) THEN
          CALL ERRPRT_IM('   <  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 538
      M_K = 123
      M_J = M_K - 2
      IF (.NOT.(M_J < M_K)) THEN
          CALL ERRPRT_IM('   <  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      RETURN
      END SUBROUTINE TEST29

      SUBROUTINE TEST30

!  Test the derived type <= interface.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type <= interface.')")

      NCASE = 539
      M_A = 123
      M_B = 124
      IF (.NOT.FM_COMP(M_A,'<=',M_B)) THEN
          CALL ERRPRT_FM('  <=  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 540
      M_A = 123
      M_B = 124
      IF (.NOT.FM_COMP(M_A,'LE',M_B)) THEN
          CALL ERRPRT_FM('  <=  ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
      ENDIF

      NCASE = 541
      J1 = 123
      M_A = J1 - 2
      IF (.NOT.(M_A <= J1)) THEN
          CALL ERRPRT_FM('  <=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 542
      J1 = 123
      M_A = J1 + 2
      IF (.NOT.(J1 <= M_A)) THEN
          CALL ERRPRT_FM('  <=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 543
      J1 = 123
      M_J = J1 - 2
      IF (.NOT.(M_J <= J1)) THEN
          CALL ERRPRT_IM('  <=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 544
      J1 = 123
      M_J = J1 + 2
      IF (.NOT.(J1 <= M_J)) THEN
          CALL ERRPRT_IM('  <=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 545
      R1 = 12.3
      M_A = R1 - 2
      IF (.NOT.(M_A <= R1)) THEN
          CALL ERRPRT_FM('  <=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 546
      R1 = 12.3
      M_A = R1 + 2
      IF (.NOT.(R1 <= M_A)) THEN
          CALL ERRPRT_FM('  <=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 547
      R1 = 123
      M_J = R1 - 2
      IF (.NOT.(M_J <= R1)) THEN
          CALL ERRPRT_IM('  <=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 548
      R1 = 123
      M_J = R1 + 2
      IF (.NOT.(R1 <= M_J)) THEN
          CALL ERRPRT_IM('  <=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 549
      D1 = 12.3
      M_A = D1 - 2
      IF (.NOT.(M_A <= D1)) THEN
          CALL ERRPRT_FM('  <=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 550
      D1 = 12.3
      M_A = D1 + 2
      IF (.NOT.(D1 <= M_A)) THEN
          CALL ERRPRT_FM('  <=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 551
      D1 = 123
      M_J = D1 - 2
      IF (.NOT.(M_J <= D1)) THEN
          CALL ERRPRT_IM('  <=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 552
      D1 = 123
      M_J = D1 + 2
      IF (.NOT.(D1 <= M_J)) THEN
          CALL ERRPRT_IM('  <=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 553
      M_B = 12.3
      M_A = M_B - 2
      IF (.NOT.(M_A <= M_B)) THEN
          CALL ERRPRT_FM('  <=  ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
      ENDIF

      NCASE = 554
      M_B = 123
      M_J = M_B - 2
      IF (.NOT.(M_J <= M_B)) THEN
          CALL ERRPRT_IM('  <=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 555
      M_B = 123
      M_J = M_B + 2
      IF (.NOT.(M_B <= M_J)) THEN
          CALL ERRPRT_IM('  <=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      NCASE = 556
      M_K = 123
      M_J = M_K - 2
      IF (.NOT.(M_J <= M_K)) THEN
          CALL ERRPRT_IM('  <=  ',M_J,'M_J',M_J,'M_J')
      ENDIF

      RETURN
      END SUBROUTINE TEST30

      SUBROUTINE TEST31

!             Test the '+' arithmetic operator.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type + interface.')")

      RSMALL = EPSILON(1.0)*100.0
      DSMALL = EPSILON(1.0D0)*100.0

      NCASE = 557
      MFM3 = J2 + MFM1
      CALL FM_ST2M('131',MFM4)
      CALL FM_ADD(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 558
      MFM3 = J2 + MFM1
      CALL FM_ST2M('131',MFM4)
      CALL FM_ADD_R1(MFM4,MFM1)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 559
      MFM3 = J2 + MFM1
      CALL FM_ST2M('131',MFM4)
      CALL FM_ADD_R2(MFM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 560
      MIM3 = J2 + MIM1
      CALL IM_ST2M('131',MIM4)
      CALL IM_ADD(MIM4,MIM1,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 561
      MZM3 = J2 + MZM1
      CALL ZM_ST2M('131',MZM4)
      CALL ZM_ADD(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 562
      MFM3 = R2 + MFM1
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_ADD(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 563
      MFM3 = R2 + MFM1
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_ADD(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV_R1(MFM4,MFM3)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 564
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_ST2M('661',MFM3)
      CALL FM_ADD(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = R2 + MIM1
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 565
      MZM3 = R2 + MZM1
      CALL ZM_ST2M('241.21',MZM4)
      CALL ZM_ADD(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 566
      MFM3 = D2 + MFM1
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_ADD(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 567
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_ST2M('661',MFM3)
      CALL FM_ADD(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = D2 + MIM1
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 568
      MZM3 = D2 + MZM1
      CALL ZM_ST2M('391.61',MZM4)
      CALL ZM_ADD(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 569
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_ADD(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = C2 + MFM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 570
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ST2M('661',MZM3)
      CALL ZM_ADD(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = C2 + MIM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 571
      MZM3 = C2 + MZM1
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ADD(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 572
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_ADD(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = CD2 + MFM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 573
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ST2M('661',MZM3)
      CALL ZM_ADD(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = CD2 + MIM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 574
      MZM3 = CD2 + MZM1
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ADD(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 575
      MFM3 = MFM1 + J2
      CALL FM_ST2M('131',MFM4)
      CALL FM_ADD(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 576
      MFM3 = MFM1 + R2
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_ADD(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 577
      MFM3 = MFM1 + D2
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_ADD(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 578
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ADD(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MFM1 + C2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 579
      CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_ADD(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MFM1 + CD2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 580
      MFM3 = MFM1 + MFM2
      CALL FM_ADD(MFM1,MFM2,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 581
      MFM3 = MFM1 + MIM1
      CALL FM_ST2M('661',MFM4)
      CALL FM_ADD(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 582
      MZM3 = MFM1 + MZM1
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_ADD(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 583
      MIM3 = MIM1 + J2
      CALL IM_ST2M('131',MIM4)
      CALL IM_ADD(MIM1,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 584
      CALL FM_ST2M('241.21',MFM3)
      CALL FM_ST2M('661',MFM4)
      CALL FM_ADD(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = MIM1 + R2
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 585
      CALL FM_ST2M('391.61',MFM3)
      CALL FM_ST2M('661',MFM4)
      CALL FM_ADD(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = MIM1 + D2
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 586
      CALL ZM_ST2M('411.11 + 421.21 i',MZM3)
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_ADD(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MIM1 + C2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 587
      CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_ADD(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MIM1 + CD2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 588
      MFM3 = MIM1 + MFM1
      CALL FM_ST2M('661',MFM4)
      CALL FM_ADD(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 589
      MIM3 = MIM1 + MIM2
      CALL IM_ADD(MIM1,MIM2,MIM4)
      IF (.NOT.(MIM4 == MIM3)) CALL PRTERR(KW)

      NCASE = 590
      MZM3 = MIM1 + MZM1
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_ADD(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 591
      MZM3 = MZM1 + J2
      CALL ZM_ST2M('131',MZM4)
      CALL ZM_ADD(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 592
      MZM3 = MZM1 + R2
      CALL ZM_ST2M('241.21',MZM4)
      CALL ZM_ADD(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 593
      MZM3 = MZM1 + D2
      CALL ZM_ST2M('391.61',MZM4)
      CALL ZM_ADD(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 594
      MZM3 = MZM1 + C2
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ADD(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 595
      MZM3 = MZM1 + CD2
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ADD(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 596
      MZM3 = MZM1 + MFM1
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_ADD(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 597
      MZM3 = MZM1 + MIM1
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_ADD(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 598
      MZM3 = MZM1 + MZM2
      CALL ZM_ADD(MZM1,MZM2,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 599
      MFM3 = +MFM1
      CALL FM_EQ(MFM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 600
      MIM3 = +MIM1
      CALL IM_EQ(MIM1,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 601
      MZM3 = +MZM1
      CALL ZM_EQ(MZM1,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      END SUBROUTINE TEST31

      SUBROUTINE TEST32

!             Test the '-' arithmetic operator.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type - interface.')")

      RSMALL = EPSILON(1.0)*100.0
      DSMALL = EPSILON(1.0D0)*100.0

      NCASE = 602
      MFM3 = J2 - MFM1
      CALL FM_ST2M('131',MFM4)
      CALL FM_SUB(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 603
      MIM3 = J2 - MIM1
      CALL IM_ST2M('131',MIM4)
      CALL IM_SUB(MIM4,MIM1,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 604
      MZM3 = J2 - MZM1
      CALL ZM_ST2M('131',MZM4)
      CALL ZM_SUB(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 605
      MFM3 = R2 - MFM1
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_SUB(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 606
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_ST2M('661',MFM3)
      CALL FM_SUB(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = R2 - MIM1
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 607
      MZM3 = R2 - MZM1
      CALL ZM_ST2M('241.21',MZM4)
      CALL ZM_SUB(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 608
      MFM3 = D2 - MFM1
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_SUB(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 609
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_ST2M('661',MFM3)
      CALL FM_SUB(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = D2 - MIM1
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 610
      MZM3 = D2 - MZM1
      CALL ZM_ST2M('391.61',MZM4)
      CALL ZM_SUB(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 611
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_SUB(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = C2 - MFM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 612
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ST2M('661',MZM3)
      CALL ZM_SUB(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = C2 - MIM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 613
      MZM3 = C2 - MZM1
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_SUB(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 614
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_SUB(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = CD2 - MFM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 615
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ST2M('661',MZM3)
      CALL ZM_SUB(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = CD2 - MIM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 616
      MZM3 = CD2 - MZM1
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_SUB(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 617
      MFM3 = MFM1 - J2
      CALL FM_ST2M('131',MFM4)
      CALL FM_SUB(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 618
      MFM3 = MFM1 - R2
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_SUB(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 619
      MFM3 = MFM1 - D2
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_SUB(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 620
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MFM1 - C2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 621
      CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_SUB(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MFM1 - CD2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 622
      MFM3 = MFM1 - MFM2
      CALL FM_SUB(MFM1,MFM2,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 623
      MFM3 = MFM1 - MIM1
      CALL FM_ST2M('661',MFM4)
      CALL FM_SUB(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 624
      MZM3 = MFM1 - MZM1
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_SUB(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 625
      MIM3 = MIM1 - J2
      CALL IM_ST2M('131',MIM4)
      CALL IM_SUB(MIM1,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 626
      CALL FM_ST2M('241.21',MFM3)
      CALL FM_ST2M('661',MFM4)
      CALL FM_SUB(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = MIM1 - R2
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 627
      CALL FM_ST2M('391.61',MFM3)
      CALL FM_ST2M('661',MFM4)
      CALL FM_SUB(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = MIM1 - D2
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 628
      CALL ZM_ST2M('411.11 + 421.21 i',MZM3)
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_SUB(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MIM1 - C2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 629
      CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_SUB(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MIM1 - CD2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 630
      MFM3 = MIM1 - MFM1
      CALL FM_ST2M('661',MFM4)
      CALL FM_SUB(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 631
      MIM3 = MIM1 - MIM2
      CALL IM_SUB(MIM1,MIM2,MIM4)
      IF (.NOT.(MIM4 == MIM3)) CALL PRTERR(KW)

      NCASE = 632
      MZM3 = MIM1 - MZM1
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_SUB(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 633
      MZM3 = MZM1 - J2
      CALL ZM_ST2M('131',MZM4)
      CALL ZM_SUB(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 634
      MZM3 = MZM1 - R2
      CALL ZM_ST2M('241.21',MZM4)
      CALL ZM_SUB(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 635
      MZM3 = MZM1 - D2
      CALL ZM_ST2M('391.61',MZM4)
      CALL ZM_SUB(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 636
      MZM3 = MZM1 - C2
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_SUB(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 637
      MZM3 = MZM1 - CD2
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_SUB(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 638
      MZM3 = MZM1 - MFM1
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_SUB(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 639
      MZM3 = MZM1 - MIM1
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_SUB(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 640
      MZM3 = MZM1 - MZM2
      CALL ZM_SUB(MZM1,MZM2,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 641
      MFM3 = -MFM1
      CALL FM_I2M(0,MFM4)
      CALL FM_SUB(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 642
      MIM3 = -MIM1
      CALL IM_I2M(0,MIM4)
      CALL IM_SUB(MIM4,MIM1,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 643
      MZM3 = -MZM1
      CALL ZM_I2M(0,MZM4)
      CALL ZM_SUB(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      END SUBROUTINE TEST32

      END MODULE TEST_A


      MODULE TEST_B
      USE TEST_VARS

      CONTAINS

      SUBROUTINE TEST33

!             Test the '*' arithmetic operator.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type * interface.')")

      RSMALL = EPSILON(1.0)*100.0
      DSMALL = EPSILON(1.0D0)*100.0

      NCASE = 644
      MFM3 = J2 * MFM1
      CALL FM_ST2M('131',MFM4)
      CALL FM_MPY(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 645
      MFM3 = J2 * MFM1
      CALL FM_ST2M('131',MFM4)
      CALL FM_MPY_R1(MFM4,MFM1)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 646
      MFM3 = J2 * MFM1
      CALL FM_ST2M('131',MFM4)
      CALL FM_MPY_R2(MFM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 647
      MFM3 = J2 * MFM1
      MFM4 = MFM1
      CALL FM_MPYI_R1(MFM4,131)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 648
      MIM3 = J2 * MIM1
      CALL IM_ST2M('131',MIM4)
      CALL IM_MPY(MIM4,MIM1,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 649
      MZM3 = J2 * MZM1
      CALL ZM_ST2M('131',MZM4)
      CALL ZM_MPY(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 650
      MFM3 = R2 * MFM1
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_MPY(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 651
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_ST2M('661',MFM3)
      CALL FM_MPY(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = R2 * MIM1
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 652
      MZM3 = R2 * MZM1
      CALL ZM_ST2M('241.21',MZM4)
      CALL ZM_MPY(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 653
      MFM3 = D2 * MFM1
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_MPY(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 654
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_ST2M('661',MFM3)
      CALL FM_MPY(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = D2 * MIM1
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 655
      MZM3 = D2 * MZM1
      CALL ZM_ST2M('391.61',MZM4)
      CALL ZM_MPY(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 656
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_MPY(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = C2 * MFM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 657
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ST2M('661',MZM3)
      CALL ZM_MPY(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = C2 * MIM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 658
      MZM3 = C2 * MZM1
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_MPY(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 659
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_MPY(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = CD2 * MFM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 660
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ST2M('661',MZM3)
      CALL ZM_MPY(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = CD2 * MIM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 661
      MZM3 = CD2 * MZM1
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_MPY(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 662
      MFM3 = MFM1 * J2
      CALL FM_ST2M('131',MFM4)
      CALL FM_MPY(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 663
      MFM3 = MFM1 * R2
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_MPY(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 664
      MFM3 = MFM1 * D2
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_MPY(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 665
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_MPY(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MFM1 * C2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 666
      CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_MPY(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MFM1 * CD2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 667
      MFM3 = MFM1 * MFM2
      CALL FM_MPY(MFM1,MFM2,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 668
      MFM3 = MFM1 * MIM1
      CALL FM_ST2M('661',MFM4)
      CALL FM_MPY(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 669
      MZM3 = MFM1 * MZM1
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_MPY(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 670
      MIM3 = MIM1 * J2
      CALL IM_ST2M('131',MIM4)
      CALL IM_MPY(MIM1,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 671
      CALL FM_ST2M('241.21',MFM3)
      CALL FM_ST2M('661',MFM4)
      CALL FM_MPY(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = MIM1 * R2
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 672
      CALL FM_ST2M('391.61',MFM3)
      CALL FM_ST2M('661',MFM4)
      CALL FM_MPY(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = MIM1 * D2
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 673
      CALL ZM_ST2M('411.11 + 421.21 i',MZM3)
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_MPY(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MIM1 * C2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 674
      CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_MPY(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MIM1 * CD2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 675
      MFM3 = MIM1 * MFM1
      CALL FM_ST2M('661',MFM4)
      CALL FM_MPY(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 676
      MIM3 = MIM1 * MIM2
      CALL IM_MPY(MIM1,MIM2,MIM4)
      IF (.NOT.(MIM4 == MIM3)) CALL PRTERR(KW)

      NCASE = 677
      MZM3 = MIM1 * MZM1
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_MPY(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 678
      MZM3 = MZM1 * J2
      CALL ZM_ST2M('131',MZM4)
      CALL ZM_MPY(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 679
      MZM3 = MZM1 * R2
      CALL ZM_ST2M('241.21',MZM4)
      CALL ZM_MPY(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 680
      MZM3 = MZM1 * D2
      CALL ZM_ST2M('391.61',MZM4)
      CALL ZM_MPY(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 681
      MZM3 = MZM1 * C2
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_MPY(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 682
      MZM3 = MZM1 * CD2
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_MPY(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 683
      MZM3 = MZM1 * MFM1
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_MPY(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 684
      MZM3 = MZM1 * MIM1
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_MPY(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 685
      MZM3 = MZM1 * MZM2
      CALL ZM_MPY(MZM1,MZM2,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      END SUBROUTINE TEST33

      SUBROUTINE TEST34

!             Test the '/' arithmetic operator.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type / interface.')")

      RSMALL = EPSILON(1.0)*100.0
      DSMALL = EPSILON(1.0D0)*100.0

      NCASE = 686
      MFM3 = J2 / MFM1
      CALL FM_ST2M('131',MFM4)
      CALL FM_DIV(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 687
      MFM3 = J2 / MFM1
      CALL FM_ST2M('131',MFM4)
      CALL FM_EQ(MFM1,MFM6)
      CALL FM_DIV_R2(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 688
      MIM3 = J2 / MIM1
      CALL IM_ST2M('131',MIM4)
      CALL IM_DIV(MIM4,MIM1,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 689
      MZM3 = J2 / MZM1
      CALL ZM_ST2M('131',MZM4)
      CALL ZM_DIV(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 690
      MFM3 = R2 / MFM1
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_DIV(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 691
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_ST2M('661',MFM3)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = R2 / MIM1
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 692
      MZM3 = R2 / MZM1
      CALL ZM_ST2M('241.21',MZM4)
      CALL ZM_DIV(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 693
      MFM3 = D2 / MFM1
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_DIV(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 694
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_ST2M('661',MFM3)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = D2 / MIM1
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 695
      MZM3 = D2 / MZM1
      CALL ZM_ST2M('391.61',MZM4)
      CALL ZM_DIV(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 696
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_DIV(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = C2 / MFM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 697
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ST2M('661',MZM3)
      CALL ZM_DIV(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = C2 / MIM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 698
      MZM3 = C2 / MZM1
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_DIV(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 699
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_DIV(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = CD2 / MFM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 700
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ST2M('661',MZM3)
      CALL ZM_DIV(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = CD2 / MIM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 701
      MZM3 = CD2 / MZM1
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_DIV(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 702
      MFM3 = MFM1 / J2
      CALL FM_ST2M('131',MFM4)
      CALL FM_DIV(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 703
      MFM3 = MFM1 / R2
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_DIV(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 704
      MFM3 = MFM1 / D2
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_DIV(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 705
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_DIV(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MFM1 / C2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 706
      CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_DIV(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MFM1 / CD2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 707
      MFM3 = MFM1 / MFM2
      CALL FM_DIV(MFM1,MFM2,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 708
      MFM3 = MFM1 / MIM1
      CALL FM_ST2M('661',MFM4)
      CALL FM_DIV(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 709
      MZM3 = MFM1 / MZM1
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_DIV(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 710
      MIM3 = MIM1 / J2
      CALL IM_ST2M('131',MIM4)
      CALL IM_DIV(MIM1,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 711
      CALL FM_ST2M('241.21',MFM3)
      CALL FM_ST2M('661',MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = MIM1 / R2
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 712
      CALL FM_ST2M('391.61',MFM3)
      CALL FM_ST2M('661',MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = MIM1 / D2
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 713
      CALL ZM_ST2M('411.11 + 421.21 i',MZM3)
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_DIV(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MIM1 / C2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 714
      CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_DIV(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MIM1 / CD2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 715
      MFM3 = MIM1 / MFM1
      CALL FM_ST2M('661',MFM4)
      CALL FM_DIV(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 716
      MIM3 = MIM1 / MIM2
      CALL IM_DIV(MIM1,MIM2,MIM4)
      IF (.NOT.(MIM4 == MIM3)) CALL PRTERR(KW)

      NCASE = 717
      MZM3 = MIM1 / MZM1
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_DIV(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 718
      MZM3 = MZM1 / J2
      CALL ZM_ST2M('131',MZM4)
      CALL ZM_DIV(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 719
      MZM3 = MZM1 / R2
      CALL ZM_ST2M('241.21',MZM4)
      CALL ZM_DIV(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 720
      MZM3 = MZM1 / D2
      CALL ZM_ST2M('391.61',MZM4)
      CALL ZM_DIV(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 721
      MZM3 = MZM1 / C2
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_DIV(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 722
      MZM3 = MZM1 / CD2
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_DIV(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 723
      MZM3 = MZM1 / MFM1
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_DIV(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 724
      MZM3 = MZM1 / MIM1
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_DIV(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 725
      MZM3 = MZM1 / MZM2
      CALL ZM_DIV(MZM1,MZM2,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      END SUBROUTINE TEST34

      SUBROUTINE TEST35

!             Test the '**' arithmetic operator.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type ** interface.')")

!             Use a larger error tolerance for large exponents.

      RSMALL = EPSILON(1.0)*10000.0
      DSMALL = EPSILON(1.0D0)*10000.0

      NCASE = 726
      MFM3 = J2 ** MFM1
      CALL FM_ST2M('131',MFM4)
      CALL FM_POWER(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 727
      J4 = 2
      MIM3 = J4 ** MIM1
      CALL IM_ST2M('2',MIM4)
      CALL IM_POWER(MIM4,MIM1,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 728
      MZM3 = J2 ** MZM1
      CALL ZM_ST2M('131',MZM4)
      CALL ZM_POWER(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 729
      MFM3 = R2 ** MFM1
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_POWER(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 730
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_ST2M('661',MFM3)
      CALL FM_POWER(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = R2 ** MIM1
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 731
      MZM3 = R2 ** MZM1
      CALL ZM_ST2M('241.21',MZM4)
      CALL ZM_POWER(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 732
      MFM3 = D2 ** MFM1
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_POWER(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 733
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_ST2M('661',MFM3)
      CALL FM_POWER(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = D2 ** MIM1
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 734
      MZM3 = D2 ** MZM1
      CALL ZM_ST2M('391.61',MZM4)
      CALL ZM_POWER(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 735
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_POWER(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = C2 ** MFM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 736
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_ST2M('661',MZM3)
      CALL ZM_POWER(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = C2 ** MIM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 737
      MZM3 = C2 ** MZM1
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_POWER(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 738
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_POWER(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = CD2 ** MFM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 739
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_ST2M('661',MZM3)
      CALL ZM_POWER(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = CD2 ** MIM1
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 740
      MZM3 = CD2 ** MZM1
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_POWER(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 741
      MFM3 = MFM1 ** J2
      CALL FM_ST2M('131',MFM4)
      CALL FM_POWER(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 742
      MFM3 = MFM1 ** R2
      CALL FM_ST2M('241.21',MFM4)
      CALL FM_POWER(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 743
      MFM3 = MFM1 ** D2
      CALL FM_ST2M('391.61',MFM4)
      CALL FM_POWER(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 744
      CALL ZM_ST2M('581.21',MZM3)
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_POWER(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MFM1 ** C2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 745
      CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_POWER(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MFM1 ** CD2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 746
      MFM3 = MFM1 ** MFM2
      CALL FM_POWER(MFM1,MFM2,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 747
      MFM3 = MFM1 ** MIM1
      CALL FM_ST2M('661',MFM4)
      CALL FM_POWER(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 748
      MZM3 = MFM1 ** MZM1
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_POWER(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 749
      J4 = 17
      MIM3 = MIM1 ** J4
      CALL IM_ST2M('17',MIM4)
      CALL IM_POWER(MIM1,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 750
      CALL FM_ST2M('241.21',MFM3)
      CALL FM_ST2M('661',MFM4)
      CALL FM_POWER(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = MIM1 ** R2
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 751
      CALL FM_ST2M('391.61',MFM3)
      CALL FM_ST2M('661',MFM4)
      CALL FM_POWER(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = MIM1 ** D2
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 752
      CALL ZM_ST2M('411.11 + 421.21 i',MZM3)
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_POWER(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MIM1 ** C2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 753
      CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_POWER(MZM4,MZM3,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      MZM3 = MIM1 ** CD2
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 754
      MFM3 = MIM1 ** MFM1
      CALL FM_ST2M('661',MFM4)
      CALL FM_POWER(MFM4,MFM1,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)

      NCASE = 755
      MIM4 = 19
      MIM3 = MIM1 ** MIM4
      CALL IM_POWER(MIM1,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM4 == MIM3)) CALL PRTERR(KW)

      NCASE = 756
      MZM3 = MIM1 ** MZM1
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_POWER(MZM4,MZM1,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 757
      MZM3 = MZM1 ** J2
      CALL ZM_ST2M('131',MZM4)
      CALL ZM_POWER(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 758
      MZM3 = MZM1 ** R2
      CALL ZM_ST2M('241.21',MZM4)
      CALL ZM_POWER(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 759
      MZM3 = MZM1 ** D2
      CALL ZM_ST2M('391.61',MZM4)
      CALL ZM_POWER(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 760
      MZM3 = MZM1 ** C2
      CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
      CALL ZM_POWER(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > RSMALL) CALL PRTERR(KW)

      NCASE = 761
      MZM3 = MZM1 ** CD2
      CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
      CALL ZM_POWER(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      IF (MFM4 > DSMALL) CALL PRTERR(KW)

      NCASE = 762
      MZM3 = MZM1 ** MFM1
      CALL ZM_ST2M('581.21',MZM4)
      CALL ZM_POWER(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 763
      MZM3 = MZM1 ** MIM1
      CALL ZM_ST2M('661',MZM4)
      CALL ZM_POWER(MZM1,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      NCASE = 764
      MZM3 = MZM1 ** MZM2
      CALL ZM_POWER(MZM1,MZM2,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)

      END SUBROUTINE TEST35

      SUBROUTINE TEST36

!             Test functions ABS, ..., CEILING.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type ABS, ..., CEILING interfaces.')")

      NCASE = 765
      MFM3 = ABS(MFM1)
      CALL FM_ABS(MFM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 766
      MIM3 = ABS(MIM1)
      CALL IM_ABS(MIM1,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 767
      MFM3 = ABS(MZM1)
      CALL ZM_ABS(MZM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 768
      MFMV1 = TO_FM( (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /) )
      MFMV2 = ABS(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ABS(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 769
      MIMV1 = TO_IM( (/ 12, -34, 56 /) )
      MIMV2 = ABS(MIMV1)
      DO J = 1, 3
         IF (.NOT.(MIMV2(J) == ABS(MIMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 770
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV2 = ABS(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ABS(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 771
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = ABS(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ABS(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 772
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = (-1)**(J+K) * TO_IM(25+3*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIMB2 = ABS(MIMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMB2(J,K) == ABS(MIMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 773
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFMB = ABS(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ABS(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 774
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = ACOS(MFM4)
      CALL FM_ACOS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 775
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = ACOS(MZM4)
      CALL ZM_ACOS(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 776
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = ACOS(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ACOS(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 777
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = ACOS(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == ACOS(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 778
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = ACOS(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ACOS(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 779
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = ACOS(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == ACOS(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 780
      CALL FM_ST2M('1.7654',MFM4)
      MFM3 = ACOSH(MFM4)
      CALL FM_ACOSH(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 781
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = ACOSH(MZM4)
      CALL ZM_ACOSH(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 782
      MFMV1 = TO_FM( (/ 1.121123456789D0, 2.342123456789D0, 3.563123456789D0 /) )
      MFMV2 = ACOSH(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ACOSH(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 783
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = ACOSH(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == ACOSH(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 784
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = 1 + TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = ACOSH(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ACOSH(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 785
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = ACOSH(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == ACOSH(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 786
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MFM3 = AIMAG(MZM4)
      CALL ZM_IMAG(MZM4,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 787
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV2 = AIMAG(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == AIMAG(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 788
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFMB = AIMAG(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == AIMAG(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 789
      MFM3 = AINT(MFM1)
      CALL FM_INT(MFM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 790
      MZM3 = AINT(MZM1)
      CALL ZM_INT(MZM1,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 791
      MFMV1 = TO_FM( (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /) )
      MFMV2 = AINT(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == AINT(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 792
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = AINT(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == AINT(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 793
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = AINT(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == AINT(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 794
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = AINT(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == AINT(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 795
      MFM3 = ANINT(MFM1)
      CALL FM_NINT(MFM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 796
      MZM3 = ANINT(MZM1)
      CALL ZM_NINT(MZM1,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 797
      MFMV1 = TO_FM( (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /) )
      MFMV2 = ANINT(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ANINT(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 798
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = ANINT(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == ANINT(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 799
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = ANINT(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ANINT(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 800
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = ANINT(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == ANINT(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 801
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = ASIN(MFM4)
      CALL FM_ASIN(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 802
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = ASIN(MZM4)
      CALL ZM_ASIN(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 803
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = ASIN(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ASIN(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 804
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = ASIN(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == ASIN(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 805
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = ASIN(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ASIN(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 806
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = ASIN(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == ASIN(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 807
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = ASINH(MFM4)
      CALL FM_ASINH(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 808
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = ASINH(MZM4)
      CALL ZM_ASINH(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 809
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = ASINH(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ASINH(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 810
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = ASINH(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == ASINH(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 811
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = ASINH(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ASINH(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 812
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = ASINH(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == ASINH(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 813
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = ATAN(MFM4)
      CALL FM_ATAN(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 814
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = ATAN(MZM4)
      CALL ZM_ATAN(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 815
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = ATAN(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ATAN(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 816
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = ATAN(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == ATAN(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 817
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = ATAN(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ATAN(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 818
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = ATAN(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == ATAN(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 819
      MFM3 = ATAN2(MFM1,MFM2)
      CALL FM_ATAN2(MFM1,MFM2,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 820
      MFM3 = ATAN2(MFM1,MFM2)
      CALL FM_ATAN2(MFM1,MFM2,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 821
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = ATANH(MFM4)
      CALL FM_ATANH(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 822
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = ATANH(MZM4)
      CALL ZM_ATANH(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 823
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = ATANH(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ATANH(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 824
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = ATANH(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == ATANH(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 825
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = ATANH(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ATANH(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 826
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = ATANH(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == ATANH(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 827
      JERR = -1
      DO J = 0, 10
         IF (BTEST(661,J)) THEN
             IF (.NOT.BTEST(MIM1,J)) JERR = J
         ELSE
             IF (BTEST(MIM1,J)) JERR = J
         ENDIF
      ENDDO
      IF (JERR >= 0) CALL PRTERR(KW)

      NCASE = 828
      CALL FM_ST2M('12.37654',MFM4)
      MFM3 = CEILING(MFM4)
      CALL FM_ST2M('13',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 829
      CALL FM_ST2M('12.0',MFM4)
      MFM3 = CEILING(MFM4)
      CALL FM_ST2M('12',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 830
      CALL FM_ST2M('-12.7654',MFM4)
      MFM3 = CEILING(MFM4)
      CALL FM_ST2M('-12',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 831
      CALL FM_ST2M('-12.7654',MFM4)
      CALL FM_CEILING(MFM4,MFM3)
      CALL FM_ST2M('-12',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 832
      CALL ZM_ST2M('12.37654 - 22.54 i',MZM4)
      MZM3 = CEILING(MZM4)
      CALL ZM_ST2M('13 - 22 i',MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 833
      CALL ZM_ST2M('12.0 - 22.0 i',MZM4)
      MZM3 = CEILING(MZM4)
      CALL ZM_ST2M('12 - 22 i',MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 834
      CALL ZM_ST2M('-12.7654 + 22.31 i',MZM4)
      MZM3 = CEILING(MZM4)
      CALL ZM_ST2M('-12 + 23 i',MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 835
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = CEILING(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == CEILING(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 836
      MIMV1 = TO_IM( (/ 12, -34, 56 /) )
      MIMV2 = CEILING(MIMV1)
      DO J = 1, 3
         IF (.NOT.(MIMV2(J) == CEILING(MIMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 837
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = CEILING(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == CEILING(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 838
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = CEILING(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == CEILING(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 839
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = (-1)**(J+K) * TO_IM(25+3*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIMB2 = CEILING(MIMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMB2(J,K) == CEILING(MIMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 840
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = CEILING(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == CEILING(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      END SUBROUTINE TEST36

      SUBROUTINE TEST37

!             Test functions CMPLX, ..., EXPONENT.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type CMPLX, ..., EXPONENT interfaces.')")

      NCASE = 841
      MZM3 = CMPLX(MFM1,MFM2)
      CALL ZM_COMPLEX(MFM1,MFM2,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 842
      MZM3 = CMPLX(MFM1,MFM2)
      CALL ZMCOMPLEX(MFM1%MFM,MFM2%MFM,MZM5%MZM)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 843
      MZM3 = CMPLX(MIM1,MIM2)
      CALL IM_I2FM(MIM1,MFM3)
      CALL IM_I2FM(MIM2,MFM4)
      CALL ZM_COMPLEX(MFM3,MFM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 844
      MZM3 = CMPLX(MFM1)
      CALL FM_I2M(0,MFM4)
      CALL ZM_COMPLEX(MFM1,MFM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 845
      MZM3 = CMPLX(MIM1)
      CALL IM_I2FM(MIM1,MFM3)
      CALL FM_I2M(0,MFM4)
      CALL ZM_COMPLEX(MFM3,MFM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 846
      MZM3 = CONJG(MZM1)
      CALL ZM_CONJUGATE(MZM1,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 847
      MZM3 = CONJG(MZM1)
      CALL ZMCONJUGATE(MZM1%MZM,MZM4%MZM)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 848
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = CONJG(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == CONJG(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 849
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = CONJG(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == CONJG(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 850
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = COS(MFM4)
      CALL FM_COS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 851
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = COS(MZM4)
      CALL ZM_COS(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 852
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = COS(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == COS(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 853
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = COS(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == COS(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 854
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = COS(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == COS(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 855
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = COS(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == COS(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 856
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = COSH(MFM4)
      CALL FM_COSH(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 857
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = COSH(MZM4)
      CALL ZM_COSH(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 858
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = COSH(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == COSH(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 859
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = COSH(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == COSH(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 860
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = COSH(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == COSH(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 861
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = COSH(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == COSH(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 862
      MFM3 = DBLE(MFM1)
      CALL FM_EQ(MFM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 863
      MFM3 = DBLE(MIM1)
      CALL IM_I2FM(MIM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 864
      MFM3 = DBLE(MZM1)
      CALL ZM_REAL(MZM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 865
      J = DIGITS(MFM1)
      IF (J /= NDIG) CALL PRTERR(KW)

      NCASE = 866
      J = DIGITS(MIM1)
      IF (J /= SIZE_OF_MWK/10) CALL PRTERR(KW)

      NCASE = 867
      J = DIGITS(MZM1)
      IF (J /= NDIG) CALL PRTERR(KW)

      NCASE = 868
      MFM3 = DIM(MFM1,MFM2)
      CALL FM_DIM(MFM1,MFM2,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 869
      MIM3 = DIM(MIM1,MIM2)
      CALL IM_DIM(MIM1,MIM2,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 870
      MFM3 = DINT(MFM1)
      CALL FM_INT(MFM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 871
      MZM3 = DINT(MZM1)
      CALL ZM_INT(MZM1,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 872
      MFM3 = TO_FM(' 12.34 ')
      IF (IS_OVERFLOW(MFM3)) CALL PRTERR(KW)

      NCASE = 873
      MFM3 = TO_FM(' OVERFLOW ')
      IF (.NOT. IS_OVERFLOW(MFM3)) CALL PRTERR(KW)

      NCASE = 874
      MFM3 = TO_FM(' -OVERFLOW ')
      IF (.NOT. IS_OVERFLOW(MFM3)) CALL PRTERR(KW)

      NCASE = 875
      MIM3 = TO_IM(' 123456e+345 ')
      IF (IS_OVERFLOW(MIM3)) CALL PRTERR(KW)

      NCASE = 876
      MIM3 = TO_IM(' OVERFLOW ')
      IF (.NOT. IS_OVERFLOW(MIM3)) CALL PRTERR(KW)

      NCASE = 877
      MIM3 = TO_IM(' -OVERFLOW ')
      IF (.NOT. IS_OVERFLOW(MIM3)) CALL PRTERR(KW)

      NCASE = 878
      MZM3 = TO_ZM(' 45.67 - 0.4321 i ')
      IF (IS_OVERFLOW(MZM3)) CALL PRTERR(KW)

      NCASE = 879
      MZM3 = TO_ZM(' OVERFLOW + OVERFLOW i ')
      IF (.NOT. IS_OVERFLOW(MZM3)) CALL PRTERR(KW)

      NCASE = 880
      MZM3 = TO_ZM(' -OVERFLOW - OVERFLOW i ')
      IF (.NOT. IS_OVERFLOW(MZM3)) CALL PRTERR(KW)

      NCASE = 881
      MFM3 = TO_FM(' 12.34 ')
      IF (IS_UNDERFLOW(MFM3)) CALL PRTERR(KW)

      NCASE = 882
      MFM3 = TO_FM(' UNDERFLOW ')
      IF (.NOT. IS_UNDERFLOW(MFM3)) CALL PRTERR(KW)

      NCASE = 883
      MFM3 = TO_FM(' -UNDERFLOW ')
      IF (.NOT. IS_UNDERFLOW(MFM3)) CALL PRTERR(KW)

      NCASE = 884
      MIM3 = TO_IM(' 123456e+345 ')
      IF (IS_UNDERFLOW(MIM3)) CALL PRTERR(KW)

!             Note TO_IM(' UNDERFLOW ') gives zero.

      NCASE = 885
      MIM3 = TO_IM(' UNDERFLOW ')
      IF (IS_UNDERFLOW(MIM3)) CALL PRTERR(KW)

      NCASE = 886
      MIM3 = TO_IM(' -UNDERFLOW ')
      IF (IS_UNDERFLOW(MIM3)) CALL PRTERR(KW)

      NCASE = 887
      MZM3 = TO_ZM(' 45.67 - 0.4321 i ')
      IF (IS_UNDERFLOW(MZM3)) CALL PRTERR(KW)

      NCASE = 888
      MZM3 = TO_ZM(' UNDERFLOW + UNDERFLOW i ')
      IF (.NOT. IS_UNDERFLOW(MZM3)) CALL PRTERR(KW)

      NCASE = 889
      MZM3 = TO_ZM(' -UNDERFLOW - UNDERFLOW i ')
      IF (.NOT. IS_UNDERFLOW(MZM3)) CALL PRTERR(KW)

      NCASE = 890
      MFM3 = TO_FM(' 12.34 ')
      IF (IS_UNKNOWN(MFM3)) CALL PRTERR(KW)

      NCASE = 891
      MFM3 = TO_FM(' UNKNOWN ')
      IF (.NOT. IS_UNKNOWN(MFM3)) CALL PRTERR(KW)

      NCASE = 892
      MFM3 = TO_FM(' UNKNOWN ')
      IF (.NOT. IS_UNKNOWN(MFM3)) CALL PRTERR(KW)

      NCASE = 893
      MIM3 = TO_IM(' 123456e+345 ')
      IF (IS_UNKNOWN(MIM3)) CALL PRTERR(KW)

      NCASE = 894
      MIM3 = TO_IM(' UNKNOWN ')
      IF (.NOT. IS_UNKNOWN(MIM3)) CALL PRTERR(KW)

      NCASE = 895
      MIM3 = TO_IM(' UNKNOWN ')
      IF (.NOT. IS_UNKNOWN(MIM3)) CALL PRTERR(KW)

      NCASE = 896
      MZM3 = TO_ZM(' 45.67 - 0.4321 i ')
      IF (IS_UNKNOWN(MZM3)) CALL PRTERR(KW)

      NCASE = 897
      MZM3 = TO_ZM(' UNKNOWN + 2.6 i ')
      IF (.NOT. IS_UNKNOWN(MZM3)) CALL PRTERR(KW)

      NCASE = 898
      MZM3 = TO_ZM(' -3.7 - UNKNOWN i ')
      IF (.NOT. IS_UNKNOWN(MZM3)) CALL PRTERR(KW)

      NCASE = 899
      CALL FM_ST2M('1.23',MFMV1(1))
      CALL FM_ST2M('2.23',MFMV1(2))
      CALL FM_ST2M('3.23',MFMV1(3))
      CALL FM_ST2M('4.23',MFMV2(1))
      CALL FM_ST2M('5.23',MFMV2(2))
      CALL FM_ST2M('6.23',MFMV2(3))
      MFM3 = DOT_PRODUCT(MFMV1,MFMV2)
      MFM4 = 0
      DO J = 1, 3
         MFM4 = MFM4 + MFMV1(J)*MFMV2(J)
      ENDDO
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 900
      IF (IS_OVERFLOW(MFMV1)) CALL PRTERR(KW)

      NCASE = 901
      MFMV1(3) = TO_FM(' OVERFLOW ')
      IF (.NOT. IS_OVERFLOW(MFMV1)) CALL PRTERR(KW)

      NCASE = 902
      IF (IS_UNDERFLOW(MFMV1)) CALL PRTERR(KW)

      NCASE = 903
      MFMV1(3) = TO_FM(' -UNDERFLOW ')
      IF (.NOT. IS_UNDERFLOW(MFMV1)) CALL PRTERR(KW)

      NCASE = 904
      IF (IS_UNKNOWN(MFMV1)) CALL PRTERR(KW)

      NCASE = 905
      MFMV1(3) = TO_FM(' UNKNOWN ')
      IF (.NOT. IS_UNKNOWN(MFMV1)) CALL PRTERR(KW)

      NCASE = 906
      CALL IM_ST2M('12',MIMV1(1))
      CALL IM_ST2M('23',MIMV1(2))
      CALL IM_ST2M('34',MIMV1(3))
      CALL IM_ST2M('-14',MIMV2(1))
      CALL IM_ST2M('-5',MIMV2(2))
      CALL IM_ST2M('16',MIMV2(3))
      MIM3 = DOT_PRODUCT(MIMV1,MIMV2)
      MIM4 = 0
      DO J = 1, 3
         MIM4 = MIM4 + MIMV1(J)*MIMV2(J)
      ENDDO
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 907
      IF (IS_OVERFLOW(MIMV1)) CALL PRTERR(KW)

      NCASE = 908
      MIMV1(2) = TO_IM(' -OVERFLOW ')
      IF (.NOT. IS_OVERFLOW(MIMV1)) CALL PRTERR(KW)

      NCASE = 909
      IF (IS_UNDERFLOW(MIMV1)) CALL PRTERR(KW)

      NCASE = 910
      MIMV1(2) = TO_IM(' -UNDERFLOW ')
      IF (IS_UNDERFLOW(MIMV1)) CALL PRTERR(KW)

      NCASE = 911
      IF (IS_UNKNOWN(MIMV1)) CALL PRTERR(KW)

      NCASE = 912
      MIMV1(2) = TO_IM(' UNKNOWN ')
      IF (.NOT. IS_UNKNOWN(MIMV1)) CALL PRTERR(KW)

      NCASE = 913
      CALL ZM_ST2M('1.23 + 1.67 i',MZMV1(1))
      CALL ZM_ST2M('2.23 - 2.56 i',MZMV1(2))
      CALL ZM_ST2M('3.23 + 3.45 i',MZMV1(3))
      CALL ZM_ST2M('4.23 - 4.34 i',MZMV2(1))
      CALL ZM_ST2M('5.23 + 5.23 i',MZMV2(2))
      CALL ZM_ST2M('6.23 - 6.12 i',MZMV2(3))
      MZM3 = DOT_PRODUCT(MZMV1,MZMV2)
      MZM4 = 0
      DO J = 1, 3
         MZM4 = MZM4 + CONJG(MZMV1(J))*MZMV2(J)
      ENDDO
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 914
      IF (IS_OVERFLOW(MZMV1)) CALL PRTERR(KW)

      NCASE = 915
      MZMV1(2) = TO_ZM(' -OVERFLOW - OVERFLOW i ')
      IF (.NOT. IS_OVERFLOW(MZMV1)) CALL PRTERR(KW)

      NCASE = 916
      IF (IS_UNDERFLOW(MZMV1)) CALL PRTERR(KW)

      NCASE = 917
      MZMV1(2) = TO_ZM(' -UNDERFLOW - UNDERFLOW i ')
      IF (.NOT. IS_UNDERFLOW(MZMV1)) CALL PRTERR(KW)

      NCASE = 918
      IF (IS_UNKNOWN(MZMV1)) CALL PRTERR(KW)

      NCASE = 919
      MZMV1(2) = TO_ZM(' -3.7 - UNKNOWN i ')
      IF (.NOT. IS_UNKNOWN(MZMV1)) CALL PRTERR(KW)

      NCASE = 920
      MFM3 = EPSILON(MFM1)
      CALL FM_I2M(1,MFM4)
      CALL FM_ULP(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 921
      CALL FM_EPSILON(MFM1,MFM3)
      CALL FM_I2M(1,MFM4)
      CALL FM_ULP(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 922
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = EXP(MFM4)
      CALL FM_EXP(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 923
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = EXP(MZM4)
      CALL ZM_EXP(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 924
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = EXP(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == EXP(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 925
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = EXP(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == EXP(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 926
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = EXP(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == EXP(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 927
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = EXP(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == EXP(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 928
      J = EXPONENT(MFM1)
      IF (J /= INT(MWK(START(MFM1%MFM)+2))) CALL PRTERR(KW)

      END SUBROUTINE TEST37

      SUBROUTINE TEST38

!             Test functions FLOOR, ..., MIN.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type FLOOR, ..., MIN interfaces.')")

      NCASE = 929
      CALL FM_ST2M('12.37654',MFM4)
      MFM3 = FLOOR(MFM4)
      CALL FM_ST2M('12',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 930
      CALL FM_ST2M('12.0',MFM4)
      MFM3 = FLOOR(MFM4)
      CALL FM_ST2M('12',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 931
      CALL FM_ST2M('-12.7654',MFM4)
      MFM3 = FLOOR(MFM4)
      CALL FM_ST2M('-13',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 932
      CALL FM_ST2M('-12.7654',MFM4)
      CALL FM_FLOOR(MFM4,MFM3)
      CALL FM_ST2M('-13',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 933
      CALL IM_ST2M('12',MIM4)
      MIM3 = FLOOR(MIM4)
      CALL IM_ST2M('12',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 934
      CALL IM_ST2M('-123',MIM4)
      MIM3 = FLOOR(MIM4)
      CALL IM_ST2M('-123',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 935
      CALL ZM_ST2M('12.37654 - 22.54 i',MZM4)
      MZM3 = FLOOR(MZM4)
      CALL ZM_ST2M('12 - 23 i',MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 936
      CALL ZM_ST2M('12.0 - 22.0 i',MZM4)
      MZM3 = FLOOR(MZM4)
      CALL ZM_ST2M('12 - 22 i',MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 937
      CALL ZM_ST2M('-12.7654 + 22.31 i',MZM4)
      MZM3 = FLOOR(MZM4)
      CALL ZM_ST2M('-13 + 22 i',MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 938
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = FLOOR(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == FLOOR(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 939
      MIMV1 = TO_IM( (/ 12, -34, 56 /) )
      MIMV2 = FLOOR(MIMV1)
      DO J = 1, 3
         IF (.NOT.(MIMV2(J) == FLOOR(MIMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 940
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = FLOOR(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == FLOOR(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 941
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = FLOOR(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == FLOOR(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 942
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = (-1)**(J+K) * TO_IM(25+3*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIMB2 = FLOOR(MIMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMB2(J,K) == FLOOR(MIMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 943
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = FLOOR(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == FLOOR(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 944
      CALL FM_ST2M('12.37654',MFM4)
      MFM3 = FRACTION(MFM4)
      MWK(START(MFM4%MFM)+2) = 0
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 945
      CALL FM_ST2M('12.37654',MFM4)
      CALL FM_FRACTION(MFM4,MFM3)
      MWK(START(MFM4%MFM)+2) = 0
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 946
      CALL ZM_ST2M('12.37654 - 22.54',MZM4)
      MZM3 = FRACTION(MZM4)
      MWK(START(MZM4%MZM(1))+2) = 0
      MWK(START(MZM4%MZM(2))+2) = 0
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 947
      MFMV1 = TO_FM( (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /) )
      MFMV2 = FRACTION(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == FRACTION(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 948
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = FRACTION(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == FRACTION(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 949
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = FRACTION(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == FRACTION(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 950
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = FRACTION(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == FRACTION(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 951
      MFM3 = HUGE(MFM1)
      CALL FM_BIG(MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 952
      MIM3 = HUGE(MIM1)
      CALL IM_BIG(MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 953
      MZM3 = HUGE(MZM1)
      CALL FM_BIG(MFM4)
      CALL ZM_COMPLEX(MFM4,MFM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 954
      MFM3 = TINY(MFM1)
      CALL FM_TINY(MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 955
      MIM3 = INT(MFM1)
      CALL FM_INT(MFM1,MFM4)
      CALL IM_FM2I(MFM4,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 956
      MIM3 = INT(MIM1)
      CALL IM_EQ(MIM1,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 957
      MIM3 = INT(MZM1)
      CALL ZM_INT(MZM1,MZM4)
      CALL ZM_REAL(MZM4,MFM4)
      CALL IM_FM2I(MFM4,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 958
      MFMV1 = TO_FM( (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /) )
      MFMV2 = INT(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == INT(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 959
      MIMV1 = TO_IM( (/ 12, -34, 56 /) )
      MIMV2 = INT(MIMV1)
      DO J = 1, 3
         IF (.NOT.(MIMV2(J) == INT(MIMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 960
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = INT(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == INT(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 961
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = INT(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == INT(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 962
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = (-1)**(J+K) * TO_IM(25+3*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIMB2 = INT(MIMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMB2(J,K) == INT(MIMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 963
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = INT(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == INT(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 964
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = LOG(MFM4)
      CALL FM_LN(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 965
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = LOG(MZM4)
      CALL ZM_LN(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 966
      MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
      MFMV2 = LOG(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == LOG(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 967
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = LOG(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == LOG(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 968
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = LOG(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == LOG(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 969
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = LOG(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == LOG(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 970
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = LOG10(MFM4)
      CALL FM_LOG10(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 971
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = LOG10(MZM4)
      CALL ZM_LOG10(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 972
      MFMV1 = TO_FM( (/ .121123456789D0, 34.2123456789D0, .563123456789D0 /) )
      MFMV2 = LOG10(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == LOG10(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 973
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = LOG10(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == LOG10(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 974
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = LOG10(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == LOG10(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 975
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = LOG10(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == LOG10(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 976
      DO I = 1, 3
         DO J = 1, 3
            MFMA(I,J) = 3*(J-1) + I
            MFMB(I,J) = 3*(I-1) + J + 10
         ENDDO
      ENDDO
      MFMC = MATMUL(MFMA,MFMB)
      MFM3 = ABS(MFMC(1,1)-186)+ABS(MFMC(1,2)-198)+ABS(MFMC(1,3)-210)+ &
             ABS(MFMC(2,1)-228)+ABS(MFMC(2,2)-243)+ABS(MFMC(2,3)-258)+ &
             ABS(MFMC(3,1)-270)+ABS(MFMC(3,2)-288)+ABS(MFMC(3,3)-306)
      IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)

      NCASE = 977
      DO I = 1, 3
         DO J = 1, 3
            MFMA(I,J) = 3*(J-1) + I
            MFMB(I,J) = 3*(I-1) + J + 10
         ENDDO
         MFMV1(I) = MFMA(1,I)
      ENDDO
      MFMV2 = MATMUL(MFMV1,MFMB)
      MFM3 = ABS(MFMV2(1)-186)+ABS(MFMV2(2)-198)+ABS(MFMV2(3)-210)
      IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)

      NCASE = 978
      IF (IS_OVERFLOW(MFMA)) CALL PRTERR(KW)

      NCASE = 979
      MFMA(3,2) = TO_FM(' OVERFLOW ')
      IF (.NOT. IS_OVERFLOW(MFMA)) CALL PRTERR(KW)

      NCASE = 980
      IF (IS_UNDERFLOW(MFMA)) CALL PRTERR(KW)

      NCASE = 981
      MFMA(3,2) = TO_FM(' UNDERFLOW ')
      IF (.NOT. IS_UNDERFLOW(MFMA)) CALL PRTERR(KW)

      NCASE = 982
      IF (IS_UNKNOWN(MFMA)) CALL PRTERR(KW)

      NCASE = 983
      MFMA(3,2) = TO_FM(' UNKNOWN ')
      IF (.NOT. IS_UNKNOWN(MFMA)) CALL PRTERR(KW)

      NCASE = 984
      DO I = 1, 3
         DO J = 1, 3
            MFMA(I,J) = 3*(J-1) + I
            MFMB(I,J) = 3*(I-1) + J + 10
         ENDDO
         MFMV1(I) = MFMB(I,1)
      ENDDO
      MFMV2 = MATMUL(MFMA,MFMV1)
      MFM3 = ABS(MFMV2(1)-186)+ABS(MFMV2(2)-228)+ABS(MFMV2(3)-270)
      IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)

      NCASE = 985
      DO I = 1, 2
         DO J = 1, 2
            MIMA(I,J) = 2*(J-1) + I + 20
            MIMB(I,J) = 2*(I-1) + J + 30
         ENDDO
      ENDDO
      MIMC = MATMUL(MIMA,MIMB)
      MIM3 = ABS(MIMC(1,1)-1410) + ABS(MIMC(1,2)-1454) + &
             ABS(MIMC(2,1)-1474) + ABS(MIMC(2,2)-1520)
      IF (.NOT.(MIM3 == 0)) CALL PRTERR(KW)

      NCASE = 986
      IF (IS_OVERFLOW(MIMA)) CALL PRTERR(KW)

      NCASE = 987
      MIMA(1,2) = TO_IM(' OVERFLOW ')
      IF (.NOT. IS_OVERFLOW(MIMA)) CALL PRTERR(KW)

      NCASE = 988
      IF (IS_UNDERFLOW(MIMA)) CALL PRTERR(KW)

      NCASE = 989
      MIMA(1,2) = TO_IM(' UNDERFLOW ')
      IF (IS_UNDERFLOW(MIMA)) CALL PRTERR(KW)

      NCASE = 990
      IF (IS_UNKNOWN(MIMA)) CALL PRTERR(KW)

      NCASE = 991
      MIMA(1,2) = TO_IM(' UNKNOWN ')
      IF (.NOT. IS_UNKNOWN(MIMA)) CALL PRTERR(KW)

      NCASE = 992
      DO I = 1, 2
         DO J = 1, 2
            MIMA(I,J) = 2*(J-1) + I + 20
            MIMB(I,J) = 2*(I-1) + J + 30
         ENDDO
         MIMV1(I) = MIMA(I,1)
      ENDDO
      MIMV2(1:2) = MATMUL(MIMV1(1:2),MIMB)
      MIM3 = ABS(MIMV2(1)-1377) + ABS(MIMV2(2)-1420)
      IF (.NOT.(MIM3 == 0)) CALL PRTERR(KW)

      NCASE = 993
      DO I = 1, 2
         DO J = 1, 2
            MIMA(I,J) = 2*(J-1) + I + 20
            MIMB(I,J) = 2*(I-1) + J + 30
         ENDDO
         MIMV1(I) = MIMB(1,I)
      ENDDO
      MIMV2(1:2) = MATMUL(MIMA,MIMV1(1:2))
      MIM3 = ABS(MIMV2(1)-1387) + ABS(MIMV2(2)-1450)
      IF (.NOT.(MIM3 == 0)) CALL PRTERR(KW)

      NCASE = 994
      DO I = 1, 2
         DO J = 1, 3
            MZMA(I,J) = CMPLX(TO_FM(2*(J-1)+I+10),TO_FM(2*(J-1)+I+20))
         ENDDO
      ENDDO
      DO I = 1, 3
         DO J = 1, 4
            MZMB(I,J) = CMPLX(TO_FM(4*(I-1)+J+50),TO_FM(4*(I-1)+J+30))
         ENDDO
      ENDDO
      MZMC = MATMUL(MZMA,MZMB)
      MFM3 = ABS(MZMC(1,1)-TO_ZM('-270 + 5192 i')) + &
             ABS(MZMC(1,2)-TO_ZM('-300 + 5300 i')) + &
             ABS(MZMC(1,3)-TO_ZM('-330 + 5408 i')) + &
             ABS(MZMC(1,4)-TO_ZM('-360 + 5516 i')) + &
             ABS(MZMC(2,1)-TO_ZM('-210 + 5462 i')) + &
             ABS(MZMC(2,2)-TO_ZM('-240 + 5576 i')) + &
             ABS(MZMC(2,3)-TO_ZM('-270 + 5690 i')) + &
             ABS(MZMC(2,4)-TO_ZM('-300 + 5804 i'))
      IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)

      NCASE = 995
      IF (IS_OVERFLOW(MZMA)) CALL PRTERR(KW)

      NCASE = 996
      MZMA(2,2) = TO_ZM(' OVERFLOW - 23.45 i ')
      IF (.NOT. IS_OVERFLOW(MZMA)) CALL PRTERR(KW)

      NCASE = 997
      IF (IS_UNDERFLOW(MZMA)) CALL PRTERR(KW)

      NCASE = 998
      MZMA(2,2) = TO_ZM(' UNDERFLOW - 23.45 i ')
      IF (.NOT. IS_UNDERFLOW(MZMA)) CALL PRTERR(KW)

      NCASE = 999
      IF (IS_UNKNOWN(MZMA)) CALL PRTERR(KW)

      NCASE = 1000
      MZMA(2,2) = TO_ZM(' UNKNOWN - 23.45 i ')
      IF (.NOT. IS_UNKNOWN(MZMA)) CALL PRTERR(KW)

      NCASE = 1001
      DO I = 1, 2
         DO J = 1, 3
            MZMA(I,J) = CMPLX(TO_FM(2*(J-1)+I+10),TO_FM(2*(J-1)+I+20))
         ENDDO
      ENDDO
      DO I = 1, 3
         DO J = 1, 4
            MZMB(I,J) = CMPLX(TO_FM(4*(I-1)+J+50),TO_FM(4*(I-1)+J+30))
         ENDDO
         MZMV1(I) = MZMA(1,I)
      ENDDO
      MZMV5 = MATMUL(MZMV1,MZMB)
      MFM3 = ABS(MZMV5(1)-TO_ZM('-270 + 5192 i')) + &
             ABS(MZMV5(2)-TO_ZM('-300 + 5300 i')) + &
             ABS(MZMV5(3)-TO_ZM('-330 + 5408 i')) + &
             ABS(MZMV5(4)-TO_ZM('-360 + 5516 i'))
      IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)

      NCASE = 1002
      DO I = 1, 2
         DO J = 1, 3
            MZMA(I,J) = CMPLX(TO_FM(2*(J-1)+I+10),TO_FM(2*(J-1)+I+20))
         ENDDO
      ENDDO
      DO I = 1, 3
         DO J = 1, 4
            MZMB(I,J) = CMPLX(TO_FM(4*(I-1)+J+50),TO_FM(4*(I-1)+J+30))
         ENDDO
         MZMV1(I) = MZMB(I,1)
      ENDDO
      MZMV2(1:2) = MATMUL(MZMA,MZMV1)
      MFM3 = ABS(MZMV2(1)-TO_ZM('-270 + 5192 i')) + &
             ABS(MZMV2(2)-TO_ZM('-210 + 5462 i'))
      IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)

      NCASE = 1003
      DO I = 1, 3
         DO J = 1, 3
            MFMA(I,J) = 3*(J-1) + I
         ENDDO
      ENDDO
      MFMC = TRANSPOSE(MFMA)
      MFM3 = ABS(MFMC(1,1)-MFMA(1,1))+ABS(MFMC(1,2)-MFMA(2,1))+ABS(MFMC(1,3)-MFMA(3,1))+ &
             ABS(MFMC(2,1)-MFMA(1,2))+ABS(MFMC(2,2)-MFMA(2,2))+ABS(MFMC(2,3)-MFMA(3,2))+ &
             ABS(MFMC(3,1)-MFMA(1,3))+ABS(MFMC(3,2)-MFMA(2,3))+ABS(MFMC(3,3)-MFMA(3,3))
      IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)

      NCASE = 1004
      DO I = 1, 3
         DO J = 1, 2
            MFME(I,J) = 7*(J-1) + I
         ENDDO
      ENDDO
      MFMF = TRANSPOSE(MFME)
      MFM3 = ABS(MFME(1,1)-MFMF(1,1))+ABS(MFME(1,2)-MFMF(2,1))+ &
             ABS(MFME(2,1)-MFMF(1,2))+ABS(MFME(2,2)-MFMF(2,2))+ &
             ABS(MFME(3,1)-MFMF(1,3))+ABS(MFME(3,2)-MFMF(2,3))
      IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)

      NCASE = 1005
      DO I = 1, 3
         DO J = 1, 3
            MIMA2(I,J) = 3*(J-1) + I
         ENDDO
      ENDDO
      MIMB2 = TRANSPOSE(MIMA2)
      MIM3 = ABS(MIMB2(1,1)-MIMA2(1,1))+ABS(MIMB2(1,2)-MIMA2(2,1))+ABS(MIMB2(1,3)-MIMA2(3,1))+ &
             ABS(MIMB2(2,1)-MIMA2(1,2))+ABS(MIMB2(2,2)-MIMA2(2,2))+ABS(MIMB2(2,3)-MIMA2(3,2))+ &
             ABS(MIMB2(3,1)-MIMA2(1,3))+ABS(MIMB2(3,2)-MIMA2(2,3))+ABS(MIMB2(3,3)-MIMA2(3,3))
      IF (.NOT.(MIM3 == 0)) CALL PRTERR(KW)

      NCASE = 1006
      DO I = 1, 3
         DO J = 1, 2
            MIMD(I,J) = 7*(J-1) + I
         ENDDO
      ENDDO
      MIME = TRANSPOSE(MIMD)
      MIM3 = ABS(MIMD(1,1)-MIME(1,1))+ABS(MIMD(1,2)-MIME(2,1))+ &
             ABS(MIMD(2,1)-MIME(1,2))+ABS(MIMD(2,2)-MIME(2,2))+ &
             ABS(MIMD(3,1)-MIME(1,3))+ABS(MIMD(3,2)-MIME(2,3))
      IF (.NOT.(MIM3 == 0)) CALL PRTERR(KW)

      NCASE = 1007
      DO I = 1, 3
         DO J = 1, 3
            MZMA2(I,J) = CMPLX(TO_FM('62.3')+3*(I+3*(J-1)), TO_FM('-72.4')+7*(I+3*(J-1)))
         ENDDO
      ENDDO
      MZMB2 = TRANSPOSE(MZMA2)
      MFM3 = ABS(MZMB2(1,1)-MZMA2(1,1))+ABS(MZMB2(1,2)-MZMA2(2,1))+ABS(MZMB2(1,3)-MZMA2(3,1))+ &
             ABS(MZMB2(2,1)-MZMA2(1,2))+ABS(MZMB2(2,2)-MZMA2(2,2))+ABS(MZMB2(2,3)-MZMA2(3,2))+ &
             ABS(MZMB2(3,1)-MZMA2(1,3))+ABS(MZMB2(3,2)-MZMA2(2,3))+ABS(MZMB2(3,3)-MZMA2(3,3))
      IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)

      NCASE = 1008
      DO I = 1, 3
         DO J = 1, 2
            MZMD(I,J) = CMPLX(TO_FM('62.3')+3*(I+3*(J-1)), TO_FM('-72.4')+7*(I+3*(J-1)))
         ENDDO
      ENDDO
      MZMA = TRANSPOSE(MZMD)
      MFM3 = ABS(MZMD(1,1)-MZMA(1,1))+ABS(MZMD(1,2)-MZMA(2,1))+ &
             ABS(MZMD(2,1)-MZMA(1,2))+ABS(MZMD(2,2)-MZMA(2,2))+ &
             ABS(MZMD(3,1)-MZMA(1,3))+ABS(MZMD(3,2)-MZMA(2,3))
      IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)

      NCASE = 1009
      MFM3 = MAX(MFM1,MFM2)
      CALL FM_MAX(MFM1,MFM2,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1010
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = MAX(MFM2,MFM1,MFM4)
      CALL FM_MAX(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_MAX(MFM2,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1011
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = MAX(MFM2,MFM1,MFM4,MFM2,MFM1,MFM4,MFM2,MFM1,MFM4,MFM2)
      CALL FM_MAX(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_MAX(MFM2,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1012
      MIM3 = MAX(MIM1,MIM2)
      CALL IM_MAX(MIM1,MIM2,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1013
      CALL IM_ST2M('7654',MIM4)
      CALL IM_ST2M('-1654',MIM3)
      MIM3 = MAX(MIM2,MIM1,MIM3,MIM4)
      CALL IM_ST2M('7654',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1014
      CALL IM_ST2M('7654',MIM4)
      CALL IM_ST2M('-1654',MIM3)
      MIM3 = MAX(MIM2,MIM1,MIM3,MIM4,MIM2,MIM1,MIM3,MIM4,MIM2,MIM1)
      CALL IM_ST2M('7654',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1015
      J = MAXEXPONENT(MFM1)
      IF (J /= INT(MXEXP)+1) CALL PRTERR(KW)

      NCASE = 1016
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      MFM3 = MAXVAL(MFMV1)
      MFM3 = ABS(MFM3 - MFMV1(3))
      CALL FM_ST2M(' 0 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1017
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM3 = MAXVAL(MFMA)
      MFM3 = ABS(MFM3 - MFMA(3,3))
      CALL FM_ST2M(' 0 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1018
      MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      MIM3 = MAXVAL(MIMV1)
      MIM3 = ABS(MIM3 - MIMV1(3))
      CALL IM_ST2M(' 0 ',MIM4)
      IF (.NOT.(MIM3 <= MIM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1019
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM3 = MAXVAL(MIMA2)
      MIM3 = ABS(MIM3 - MIMA2(3,3))
      CALL IM_ST2M(' 0 ',MIM4)
      IF (.NOT.(MIM3 <= MIM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1020
      MFM3 = MIN(MFM1,MFM2)
      CALL FM_MIN(MFM1,MFM2,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1021
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = MIN(MFM2,MFM1,MFM4)
      CALL FM_MIN(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_MIN(MFM2,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1022
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = MIN(MFM2,MFM1,MFM4,MFM2,MFM1,MFM4,MFM2,MFM1,MFM4,MFM2)
      CALL FM_MIN(MFM1,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_MIN(MFM2,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1023
      MIM3 = MIN(MIM1,MIM2)
      CALL IM_MIN(MIM1,MIM2,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1024
      CALL IM_ST2M('7654',MIM4)
      CALL IM_ST2M('-1654',MIM3)
      MIM3 = MIN(MIM2,MIM1,MIM3,MIM4)
      CALL IM_ST2M('-1654',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1025
      CALL IM_ST2M('7654',MIM4)
      CALL IM_ST2M('-1654',MIM3)
      MIM3 = MIN(MIM2,MIM1,MIM3,MIM4,MIM2,MIM1,MIM3,MIM4,MIM2,MIM1)
      CALL IM_ST2M('-1654',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      END SUBROUTINE TEST38

      SUBROUTINE TEST39

!             Test functions MINEXPONENT, ..., RRSPACING.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type MINEXPONENT, ..., RRSPACING interfaces.')")

      NCASE = 1026
      J = MINEXPONENT(MFM1)
      IF (J /= -INT(MXEXP)) CALL PRTERR(KW)

      NCASE = 1027
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM3 = MINVAL(MFMV1)
      MFM3 = ABS(MFM3 - MFMV1(2))
      CALL FM_ST2M(' 0 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1028
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM3 = MINVAL(MFMA)
      MFM3 = ABS(MFM3 - MFMA(1,1))
      CALL FM_ST2M(' 0 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1029
      MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      MIM3 = MINVAL(MIMV1)
      MIM3 = ABS(MIM3 - MIMV1(2))
      CALL IM_ST2M(' 0 ',MIM4)
      IF (.NOT.(MIM3 <= MIM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1030
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM3 = MINVAL(MIMA2)
      MIM3 = ABS(MIM3 - MIMA2(1,1))
      CALL IM_ST2M(' 0 ',MIM4)
      IF (.NOT.(MIM3 <= MIM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1031
      CALL FM_ST2M('8',MFM3)
      CALL FM_ST2M('5',MFM4)
      MFM3 = MOD(MFM3,MFM4)
      CALL FM_ST2M('3',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1032
      CALL FM_ST2M('-8',MFM3)
      CALL FM_ST2M('5',MFM4)
      MFM3 = MOD(MFM3,MFM4)
      CALL FM_ST2M('-3',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1033
      CALL FM_ST2M('8',MFM3)
      CALL FM_ST2M('-5',MFM4)
      MFM3 = MOD(MFM3,MFM4)
      CALL FM_ST2M('3',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1034
      CALL FM_ST2M('-8',MFM3)
      CALL FM_ST2M('-5',MFM4)
      MFM3 = MOD(MFM3,MFM4)
      CALL FM_ST2M('-3',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1035
      CALL IM_ST2M('8',MIM3)
      CALL IM_ST2M('5',MIM4)
      MIM3 = MOD(MIM3,MIM4)
      CALL IM_ST2M('3',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1036
      CALL IM_ST2M('-8',MIM3)
      CALL IM_ST2M('5',MIM4)
      MIM3 = MOD(MIM3,MIM4)
      CALL IM_ST2M('-3',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1037
      CALL IM_ST2M('8',MIM3)
      CALL IM_ST2M('-5',MIM4)
      MIM3 = MOD(MIM3,MIM4)
      CALL IM_ST2M('3',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1038
      CALL IM_ST2M('-8',MIM3)
      CALL IM_ST2M('-5',MIM4)
      MIM3 = MOD(MIM3,MIM4)
      CALL IM_ST2M('-3',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1039
      CALL FM_ST2M('8',MFM3)
      CALL FM_ST2M('5',MFM4)
      MFM3 = MODULO(MFM3,MFM4)
      CALL FM_ST2M('3',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1040
      CALL FM_ST2M('8',MFM3)
      CALL FM_ST2M('5',MFM4)
      CALL FM_MODULO(MFM3,MFM4,MFM5)
      CALL FM_EQ(MFM5,MFM3)
      CALL FM_ST2M('3',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1041
      CALL FM_ST2M('-8',MFM3)
      CALL FM_ST2M('5',MFM4)
      MFM3 = MODULO(MFM3,MFM4)
      CALL FM_ST2M('2',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1042
      CALL FM_ST2M('8',MFM3)
      CALL FM_ST2M('-5',MFM4)
      MFM3 = MODULO(MFM3,MFM4)
      CALL FM_ST2M('-2',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1043
      CALL FM_ST2M('-8',MFM3)
      CALL FM_ST2M('-5',MFM4)
      MFM3 = MODULO(MFM3,MFM4)
      CALL FM_ST2M('-3',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1044
      CALL IM_ST2M('8',MIM3)
      CALL IM_ST2M('5',MIM4)
      MIM3 = MODULO(MIM3,MIM4)
      CALL IM_ST2M('3',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1045
      CALL IM_ST2M('-8',MIM3)
      CALL IM_ST2M('5',MIM4)
      MIM3 = MODULO(MIM3,MIM4)
      CALL IM_ST2M('2',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1046
      CALL IM_ST2M('8',MIM3)
      CALL IM_ST2M('-5',MIM4)
      MIM3 = MODULO(MIM3,MIM4)
      CALL IM_ST2M('-2',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1047
      CALL IM_ST2M('-8',MIM3)
      CALL IM_ST2M('-5',MIM4)
      MIM3 = MODULO(MIM3,MIM4)
      CALL IM_ST2M('-3',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1048
      CALL FM_ST2M('0',MFM4)
      CALL FM_ST2M('1',MFM3)
      CALL FM_TINY(MFM5)
      MFM3 = NEAREST(MFM4,MFM3)
      IF (.NOT.(MFM3 == MFM5)) CALL PRTERR(KW)

      NCASE = 1049
      CALL FM_ST2M('0',MFM4)
      CALL FM_ST2M('-1',MFM3)
      CALL FM_TINY(MFM5)
      CALL FM_MPYI_R1(MFM5,-1)
      MFM3 = NEAREST(MFM4,MFM3)
      IF (.NOT.(MFM3 == MFM5)) CALL PRTERR(KW)

      NCASE = 1050
      CALL FM_ST2M('2.345',MFM4)
      CALL FM_ST2M('1',MFM3)
      MFM3 = NEAREST(MFM4,MFM3)
      CALL FM_ULP(MFM4,MFM5)
      CALL FM_ADD(MFM4,MFM5,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1051
      CALL FM_ST2M('2.345',MFM4)
      CALL FM_ST2M('1',MFM3)
      CALL FM_NEAREST(MFM4,MFM3,MFM5)
      CALL FM_EQ(MFM5,MFM3)
      CALL FM_ULP(MFM4,MFM5)
      CALL FM_ADD(MFM4,MFM5,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1052
      CALL FM_ST2M('2.345',MFM4)
      CALL FM_ST2M('-1',MFM3)
      MFM3 = NEAREST(MFM4,MFM3)
      CALL FM_ULP(MFM4,MFM5)
      CALL FM_SUB(MFM4,MFM5,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1053
      CALL FM_ST2M('1',MFM4)
      CALL FM_ST2M('-1',MFM3)
      MFM3 = NEAREST(MFM4,MFM3)
      CALL FM_ST2M('0.99',MFM5)
      CALL FM_ULP(MFM5,MFM6)
      CALL FM_EQ(MFM6,MFM5)
      CALL FM_SUB(MFM4,MFM5,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1054
      CALL FM_ST2M('-1',MFM4)
      CALL FM_ST2M('12',MFM3)
      MFM3 = NEAREST(MFM4,MFM3)
      CALL FM_ST2M('-0.99',MFM5)
      CALL FM_ULP(MFM5,MFM6)
      CALL FM_EQ(MFM6,MFM5)
      CALL FM_SUB(MFM4,MFM5,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1055
      MIM3 = NINT(MFM1)
      CALL FM_NINT(MFM1,MFM4)
      CALL IM_FM2I(MFM4,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1056
      MIM3 = NINT(MIM1)
      CALL IM_EQ(MIM1,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1057
      MIM3 = NINT(MZM1)
      CALL ZM_NINT(MZM1,MZM4)
      CALL ZM_REAL(MZM4,MFM4)
      CALL IM_FM2I(MFM4,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1058
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = NINT(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == NINT(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1059
      MIMV1 = TO_IM( (/ 12, -34, 56 /) )
      MIMV2 = NINT(MIMV1)
      DO J = 1, 3
         IF (.NOT.(MIMV2(J) == NINT(MIMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1060
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = NINT(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == NINT(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1061
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = NINT(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == NINT(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1062
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = (-1)**(J+K) * TO_IM(25+3*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIMB2 = NINT(MIMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMB2(J,K) == NINT(MIMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1063
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = NINT(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == NINT(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1064
      J = PRECISION(MFM1)
      IF (J /= INT(LOG10(REAL(MBASE))*(NDIG-1) + 1)) CALL PRTERR(KW)

      NCASE = 1065
      J = PRECISION(MZM1)
      IF (J /= INT(LOG10(REAL(MBASE))*(NDIG-1) + 1)) CALL PRTERR(KW)

      NCASE = 1066
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM3 = PRODUCT(MFMV1)
      MFM4 = TO_FM('-23335.371886315713067263700860897069')
      MFM3 = ABS(MFM3 - MFM4)
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1067
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM3 = PRODUCT(MFMA)
      MFM4 = TO_FM('1.11839386498724787888025199410658944266626022455926434E10')
      MFM3 = ABS(MFM3 - MFM4)
      CALL FM_ST2M(' 1.0E-35 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1068
      MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      MIM3 = PRODUCT(MIMV1)
      MIM3 = ABS(MIM3 - (-22848))
      CALL IM_ST2M(' 0 ',MIM4)
      IF (.NOT.(MIM3 <= MIM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1069
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM3 = PRODUCT(MIMA2)
      MIM3 = ABS(MIM3 - TO_IM('8821612800'))
      CALL IM_ST2M(' 0 ',MIM4)
      IF (.NOT.(MIM3 <= MIM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1070
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') ,  &
                 TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZM3 = PRODUCT(MZMV1)
      MZM4 = TO_ZM('-20423.717467422304481791683360897069 - '//  &
                   ' 22129.6037029617409201804816458 i')
      MFM3 = ABS(MZM3 - MZM4)
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1071
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)),  &
                               TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZM3 = PRODUCT(MZMA2)
      MZM4 = TO_ZM('-1.99055822653094068848240107E17 + '//  &
                   ' 2.47926597678191251226278026E17 i')
      MFM3 = ABS(MZM3 - MZM4)
      CALL FM_ST2M(' 1.0E-28 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1072
      J = RADIX(MFM1)
      IF (J /= INT(MBASE)) CALL PRTERR(KW)

      NCASE = 1073
      J = RADIX(MIM1)
      IF (J /= INT(MBASE)) CALL PRTERR(KW)

      NCASE = 1074
      J = RADIX(MZM1)
      IF (J /= INT(MBASE)) CALL PRTERR(KW)

      NCASE = 1075
      J = RANGE(MFM1)
      IF (J /= NINT((MXEXP+1)*LOG10(DBLE(MBASE)))-1) CALL PRTERR(KW)

      NCASE = 1076
      J = RANGE(MIM1)
      IF (J /= INT(SIZE_OF_MWK/10*LOG10(REAL(MBASE)))) CALL PRTERR(KW)

      NCASE = 1077
      J = RANGE(MZM1)
      IF (J /= NINT((MXEXP+1)*LOG10(DBLE(MBASE)))-1) CALL PRTERR(KW)

      NCASE = 1078
      MFM3 = REAL(MFM1)
      CALL FM_EQ(MFM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1079
      MFM3 = REAL(MIM1)
      CALL IM_I2FM(MIM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1080
      MFM3 = REAL(MZM1)
      CALL ZM_REAL(MZM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1081
      MFM3 = RRSPACING(MFM1)
      CALL FM_ABS(MFM1,MFM4)
      MWK(START(MFM4%MFM)+2) = NDIG
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1082
      CALL FM_RRSPACING(MFM1,MFM3)
      CALL FM_ABS(MFM1,MFM4)
      MWK(START(MFM4%MFM)+2) = NDIG
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      END SUBROUTINE TEST39

      SUBROUTINE TEST40

!             Test functions SCALE, ..., TINY.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type SCALE, ..., TINY interfaces.')")

      NCASE = 1083
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = SCALE(MFM4,1)
      CALL FM_MPYI(MFM4,INT(MBASE),MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1084
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = SCALE(MZM4,-2)
      CALL ZM_DIVI(MZM4,INT(MBASE),MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_DIVI(MZM4,INT(MBASE),MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1085
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = SETEXPONENT(MFM4,1)
      CALL FM_MPYI(MFM4,INT(MBASE),MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1086
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = SIGN(MFM4,MFM2)
      CALL FM_SIGN(MFM4,MFM2,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1087
      CALL IM_ST2M('231',MIM4)
      MIM3 = SIGN(MIM4,MIM2)
      CALL IM_SIGN(MIM4,MIM2,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1088
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = SIN(MFM4)
      CALL FM_SIN(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1089
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = SIN(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == SIN(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1090
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = SIN(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == SIN(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1091
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = SIN(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == SIN(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1092
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = SIN(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == SIN(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1093
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = SIN(MZM4)
      CALL ZM_SIN(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1094
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = SINH(MFM4)
      CALL FM_SINH(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1095
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = SINH(MZM4)
      CALL ZM_SINH(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1096
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = SINH(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == SINH(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1097
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = SINH(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == SINH(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1098
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = SINH(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == SINH(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1099
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = SINH(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == SINH(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1100
      CALL FM_ST2M('-0.7654',MFM4)
      MFM3 = SPACING(MFM4)
      CALL FM_ULP(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1101
      CALL FM_ST2M('-0.7654',MFM4)
      CALL FM_SPACING(MFM4,MFM3)
      CALL FM_ULP(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1102
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = SQRT(MFM4)
      CALL FM_SQRT(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1103
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = SQRT(MFM4)
      CALL FM_SQRT_R1(MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1104
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = SQRT(MZM4)
      CALL ZM_SQRT(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1105
      MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
      MFMV2 = SQRT(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == SQRT(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1106
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = SQRT(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == SQRT(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1107
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = SQRT(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == SQRT(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1108
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = SQRT(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == SQRT(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1109
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM3 = SUM(MFMV1)
      MFM4 = TO_FM('34.2123456789')
      MFM3 = ABS(MFM3 - MFM4)
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1110
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM3 = SUM(MFMA)
      MFM4 = TO_FM('120')
      MFM3 = ABS(MFM3 - MFM4)
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1111
      MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      MIM3 = SUM(MIMV1)
      MIM3 = ABS(MIM3 - 34)
      CALL IM_ST2M(' 0 ',MIM4)
      IF (.NOT.(MIM3 <= MIM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1112
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM3 = SUM(MIMA2)
      MIM3 = ABS(MIM3 - TO_IM('117'))
      CALL IM_ST2M(' 0 ',MIM4)
      IF (.NOT.(MIM3 <= MIM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1113
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') ,  &
                 TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZM3 = SUM(MZMV1)
      MZM4 = TO_ZM('34.2123456789 + 4.17498 i')
      MFM3 = ABS(MZM3 - MZM4)
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1114
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)),  &
                               TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZM3 = SUM(MZMA2)
      MZM4 = TO_ZM('695.7 - 336.6 i')
      MFM3 = ABS(MZM3 - MZM4)
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1115
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = TAN(MFM4)
      CALL FM_TAN(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1116
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = TAN(MZM4)
      CALL ZM_TAN(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1117
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = TAN(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == TAN(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1118
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = TAN(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == TAN(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1119
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = TAN(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == TAN(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1120
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = TAN(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == TAN(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1121
      CALL FM_ST2M('0.7654',MFM4)
      MFM3 = TANH(MFM4)
      CALL FM_TANH(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1122
      CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
      MZM3 = TANH(MZM4)
      CALL ZM_TANH(MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1123
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = TANH(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == TANH(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1124
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = TANH(MZMV1)
      DO J = 1, 3
         IF (.NOT.(MZMV2(J) == TANH(MZMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1125
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = TANH(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == TANH(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1126
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = TANH(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMB2(J,K) == TANH(MZMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1127
      CALL FM_BIG(MFM4)
      CALL FM_I2M(1,MFM3)
      CALL FM_DIV(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = TINY(MFM1)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1128
      MIM3 = TINY(MIM1)
      CALL IM_I2M(1,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1129
      CALL FM_BIG(MFM4)
      CALL FM_I2M(1,MFM3)
      CALL FM_DIV(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL ZM_COMPLEX(MFM4,MFM4,MZM4)
      MZM3 = TINY(MZM1)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      END SUBROUTINE TEST40

      SUBROUTINE TEST41

!             Test functions TO_FM, TO_IM, TO_ZM, ..., TO_DPZ.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type TO_FM,  ..., TO_DPZ interfaces.')")

      RSMALL = EPSILON(1.0)*100.0
      DSMALL = EPSILON(1.0D0)*100.0

      NCASE = 1130
      MFM3 = TO_FM(123)
      CALL FM_I2M(123,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1131
      MFM3 = TO_FM(123.4)
      CALL FM_SP2M(123.4,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = RSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 1132
      MFM3 = TO_FM(123.45D0)
      CALL FM_DP2M(123.45D0,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = DSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 1133
      MFM3 = TO_FM(CMPLX(123.4,567.8))
      CALL FM_SP2M(123.4,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = RSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 1134
      MFM3 = TO_FM(CMPLX(123.4D0,567.8D0,KIND(1.0D0)))
      CALL FM_DP2M(123.4D0,MFM4)
      CALL FM_SUB(MFM3,MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_DIV(MFM4,MFM3,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      CALL FM_ABS(MFM4,MFM6)
      CALL FM_EQ(MFM6,MFM4)
      MFM3 = DSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 1135
      MFM3 = TO_FM(MFM1)
      CALL FM_EQ(MFM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1136
      MFM3 = TO_FM(MIM1)
      CALL IM_I2FM(MIM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1137
      MFM3 = TO_FM(MZM1)
      CALL ZM_REAL(MZM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1138
      MFM3 = TO_FM('-123.654')
      CALL FM_ST2M('-123.654',MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1139
      JV = (/  123,  -432,  567  /)
      MFMV1 = TO_FM(JV)
      MFMV2 = JV
      DO J = 1, 3
         IF (.NOT.(MFMV1(J) == MFMV2(J))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1140
      RV = (/ 12.1, -34.2, 56.3 /)
      MFMV1 = TO_FM(RV)
      MFMV2 = RV
      DO J = 1, 3
         IF (ABS((MFMV1(J)-MFMV2(J))/MFMV2(J)) >= RSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1141
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFMV1 = TO_FM(DV)
      MFMV2 = DV
      DO J = 1, 3
         IF (ABS((MFMV1(J)-MFMV2(J))/MFMV2(J)) >= DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1142
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFMV1 = TO_FM(CV)
      MFMV2 = CV
      DO J = 1, 3
         IF (ABS((MFMV1(J)-MFMV2(J))/MFMV2(J)) >= RSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1143
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFMV1 = TO_FM(CDV)
      MFMV2 = CDV
      DO J = 1, 3
         IF (ABS((MFMV1(J)-MFMV2(J))/MFMV2(J)) >= DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1144
      MFMV4 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      MFMV1 = TO_FM(MFMV4)
      MFMV2 = MFMV4
      DO J = 1, 3
         IF (ABS(MFMV1(J)-MFMV2(J)) /= 0) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1145
      MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      MFMV1 = TO_FM(MIMV1)
      MFMV2 = MIMV1
      DO J = 1, 3
         IF (ABS(MFMV1(J)-MFMV2(J)) /= 0) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1146
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV1 = TO_FM(MZMV1)
      MFMV2 = MZMV1
      DO J = 1, 3
         IF (ABS(MFMV1(J)-MFMV2(J)) /= 0) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1147
      STV = (/ " 12.1123456789", "-34.2123456789", " 56.3123456789" /)
      MFMV1 = TO_FM(STV)
      MFMV2 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      DO J = 1, 3
         IF (ABS(MFMV1(J)-MFMV2(J)) /= 0) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1148
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFMA = TO_FM(JV2)
      MFMB = JV2
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMA(J,K) == MFMB(J,K))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1149
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFMA = TO_FM(RV2)
      MFMB = RV2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((MFMA(J,K)-MFMB(J,K))/MFMB(J,K)) >= RSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1150
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFMA = TO_FM(DV2)
      MFMB = DV2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((MFMA(J,K)-MFMB(J,K))/MFMB(J,K)) >= DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1151
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFMA = TO_FM(CV2)
      MFMB = CV2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((MFMA(J,K)-MFMB(J,K))/MFMB(J,K)) >= RSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1152
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFMA = TO_FM(CDV2)
      MFMB = CDV2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((MFMA(J,K)-MFMB(J,K))/MFMB(J,K)) >= DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1153
      DO J = 1, 3
         DO K = 1, 3
            MFMC(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMA = TO_FM(MFMC)
      MFMB = MFMC
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS(MFMA(J,K)-MFMB(J,K)) /= 0) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1154
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMA = TO_FM(MIMA2)
      MFMB = MIMA2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS(MFMA(J,K)-MFMB(J,K)) /= 0) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1155
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)),  &
                               TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFMA = TO_FM(MZMA2)
      MFMB = MZMA2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS(MFMA(J,K)-MFMB(J,K)) /= 0) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1156
      STV2 = RESHAPE( (/ " 12.1123456789", "-34.2123456789", " 56.3123456789",  &
                         " 23.1123456789", "-36.2123456789", " 66.3123456789",  &
                         " 45.1123456789", "-38.2123456789", " 76.3123456789"   &
                      /) , SHAPE = (/ 3,3 /) )
      MFMA = TO_FM(STV2)
      MFMB = RESHAPE( (/ TO_FM(" 12.1123456789"), TO_FM("-34.2123456789"),  &
                         TO_FM(" 56.3123456789"), TO_FM(" 23.1123456789"),  &
                         TO_FM("-36.2123456789"), TO_FM(" 66.3123456789"),  &
                         TO_FM(" 45.1123456789"), TO_FM("-38.2123456789"),  &
                         TO_FM(" 76.3123456789")   &
                      /) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS(MFMA(J,K)-MFMB(J,K)) /= 0) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1157
      MIM3 = TO_IM(123)
      CALL IM_I2M(123,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1158
      MIM3 = TO_IM(123.4)
      CALL FM_SP2M(123.4,MFM4)
      CALL IM_FM2I(MFM4,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1159
      MIM3 = TO_IM(1.234E+23)
      CALL FM_SP2M(1.234E+23,MFM4)
      MFM5 = ABS(MIM3-MFM4)/MFM4
      IF (MFM5 >= RSMALL) CALL PRTERR(KW)

      NCASE = 1160
      MIM3 = TO_IM(123.45D0)
      CALL FM_DP2M(123.45D0,MFM4)
      CALL IM_FM2I(MFM4,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1161
      MIM3 = TO_IM(1.234D+23)
      CALL FM_DP2M(1.234D+23,MFM4)
      MFM5 = ABS(MIM3-MFM4)/MFM4
      IF (MFM5 >= DSMALL) CALL PRTERR(KW)

      NCASE = 1162
      MIM3 = TO_IM(CMPLX(123.4,567.8))
      CALL FM_SP2M(123.4,MFM4)
      CALL IM_FM2I(MFM4,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1163
      MIM3 = TO_IM(CMPLX(1.234E+23,1.234E+23))
      CALL FM_SP2M(1.234E+23,MFM4)
      MFM5 = ABS(MIM3-MFM4)/MFM4
      IF (MFM5 >= RSMALL) CALL PRTERR(KW)

      NCASE = 1164
      MIM3 = TO_IM(CMPLX(123.4D0,567.8D0,KIND(1.0D0)))
      CALL FM_DP2M(123.4D0,MFM4)
      CALL IM_FM2I(MFM4,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1165
      MIM3 = TO_IM(CMPLX(1.234D+23,1.234D+23,KIND(1.0D0)))
      CALL FM_DP2M(1.234D+23,MFM4)
      MFM5 = ABS(MIM3-MFM4)/MFM4
      IF (MFM5 >= DSMALL) CALL PRTERR(KW)

      NCASE = 1166
      MIM3 = TO_IM(MFM1)
      CALL FM_EQ(MFM1,MFM4)
      CALL IM_FM2I(MFM4,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1167
      MIM3 = TO_IM(MIM1)
      CALL IM_I2FM(MIM1,MFM4)
      CALL IM_FM2I(MFM4,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1168
      MIM3 = TO_IM(MZM1)
      CALL ZM_REAL(MZM1,MFM4)
      CALL IM_FM2I(MFM4,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1169
      MIM3 = TO_IM('-123654')
      CALL IM_ST2M('-123654',MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1170
      JV = (/  123,  -432,  567  /)
      MIMV1 = TO_IM(JV)
      MIMV2 = JV
      DO J = 1, 3
         IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1171
      RV = (/ 12.1, -34.2, 56.3 /)
      MIMV1 = TO_IM(RV)
      MIMV2 = RV
      DO J = 1, 3
         IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1172
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIMV1 = TO_IM(DV)
      MIMV2 = DV
      DO J = 1, 3
         IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1173
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIMV1 = TO_IM(CV)
      MIMV2 = CV
      DO J = 1, 3
         IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1174
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIMV1 = TO_IM(CDV)
      MIMV2 = CDV
      DO J = 1, 3
         IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1175
      MFMV4 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      MIMV1 = TO_IM(MFMV4)
      MIMV2 = MFMV4
      DO J = 1, 3
         IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1176
      MIMV4 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      MIMV1 = TO_IM(MIMV4)
      MIMV2 = MIMV4
      DO J = 1, 3
         IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1177
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIMV1 = TO_IM(MZMV1)
      MIMV2 = MZMV1
      DO J = 1, 3
         IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1178
      STV = (/ " 12.1123456789", "-34.2123456789", " 56.3123456789" /)
      MIMV1 = TO_IM(STV)
      MIMV2 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      DO J = 1, 3
         IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1179
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIMA2 = TO_IM(JV2)
      MIMB2 = JV2
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1180
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIMA2 = TO_IM(RV2)
      MIMB2 = RV2
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1181
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIMA2 = TO_IM(DV2)
      MIMB2 = DV2
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1182
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIMA2 = TO_IM(CV2)
      MIMB2 = CV2
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1183
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIMA2 = TO_IM(CDV2)
      MIMB2 = CDV2
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1184
      DO J = 1, 3
         DO K = 1, 3
            MFMC(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMA2 = TO_IM(MFMC)
      MIMB2 = MFMC
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1185
      DO J = 1, 3
         DO K = 1, 3
            MIMC2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMA2 = TO_IM(MIMC2)
      MIMB2 = MIMC2
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1186
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)),  &
                               TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIMA2 = TO_IM(MZMA2)
      MIMB2 = MZMA2
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1187
      STV2 = RESHAPE( (/ " 12.1123456789", "-34.2123456789", " 56.3123456789",  &
                         " 23.1123456789", "-36.2123456789", " 66.3123456789",  &
                         " 45.1123456789", "-38.2123456789", " 76.3123456789"   &
                      /) , SHAPE = (/ 3,3 /) )
      MIMA2 = TO_IM(STV2)
      MIMB2 = RESHAPE( (/ TO_FM(" 12.1123456789"), TO_FM("-34.2123456789"),  &
                          TO_FM(" 56.3123456789"), TO_FM(" 23.1123456789"),  &
                          TO_FM("-36.2123456789"), TO_FM(" 66.3123456789"),  &
                          TO_FM(" 45.1123456789"), TO_FM("-38.2123456789"),  &
                          TO_FM(" 76.3123456789")   &
                       /) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1188
      MZM3 = TO_ZM(123)
      CALL ZM_I2M(123,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1189
      MZM3 = TO_ZM(123,456)
      MZM4 = TO_ZM(" 123 + 456 i ")
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1190
      MZM3 = TO_ZM(123.4)
      CALL FM_SP2M(123.4,MFM4)
      CALL FM_I2M(0,MFM5)
      CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = RSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 1191
      MZM3 = TO_ZM(123.4,-456.7)
      CALL FM_SP2M(123.4,MFM4)
      CALL FM_SP2M(-456.7,MFM5)
      CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = RSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 1192
      MZM3 = TO_ZM(123.45D0)
      CALL FM_DP2M(123.45D0,MFM4)
      CALL FM_I2M(0,MFM5)
      CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = DSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 1193
      MZM3 = TO_ZM(123.45D0,-456.78D0)
      CALL FM_DP2M(123.45D0,MFM4)
      CALL FM_DP2M(-456.78D0,MFM5)
      CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = DSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 1194
      MZM3 = TO_ZM(CMPLX(123.4,567.8))
      CALL FM_SP2M(123.4,MFM4)
      CALL FM_SP2M(567.8,MFM5)
      CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = RSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 1195
      MZM3 = TO_ZM(CMPLX(123.4D0,567.8D0,KIND(1.0D0)))
      CALL FM_DP2M(123.4D0,MFM4)
      CALL FM_DP2M(567.8D0,MFM5)
      CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
      CALL ZM_SUB(MZM3,MZM4,MZM5)
      CALL ZM_EQ(MZM5,MZM4)
      CALL ZM_ABS(MZM4,MFM5)
      CALL ZM_ABS(MZM3,MFM6)
      CALL FM_DIV(MFM5,MFM6,MFM4)
      MFM3 = DSMALL
      IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)

      NCASE = 1196
      MZM3 = TO_ZM(MFM1)
      CALL FM_EQ(MFM1,MFM4)
      CALL FM_I2M(0,MFM5)
      CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1197
      MZM3 = TO_ZM(MIM1)
      CALL IM_I2FM(MIM1,MFM4)
      CALL FM_I2M(0,MFM5)
      CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1198
      MZM3 = TO_ZM(MZM1)
      CALL ZM_EQ(MZM1,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1199
      MZM3 = TO_ZM('-123.654 + 98.7 i')
      CALL ZM_ST2M('-123.654 + 98.7 i',MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1200
      JV = (/  123,  -432,  567  /)
      MZMV1 = TO_ZM(JV)
      MZMV2 = JV
      DO J = 1, 3
         IF (ABS(MZMV1(J)-MZMV2(J)) /= 0) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1201
      RV = (/ 12.1, -34.2, 56.3 /)
      MZMV1 = TO_ZM(RV)
      MZMV2 = RV
      DO J = 1, 3
         IF (ABS((MZMV1(J)-MZMV2(J))/MZMV2(J)) >= RSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1202
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZMV1 = TO_ZM(DV)
      MZMV2 = DV
      DO J = 1, 3
         IF (ABS((MZMV1(J)-MZMV2(J))/MZMV2(J)) >= DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1203
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZMV1 = TO_ZM(CV)
      MZMV2 = CV
      DO J = 1, 3
         IF (ABS((MZMV1(J)-MZMV2(J))/MZMV2(J)) >= RSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1204
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZMV1 = TO_ZM(CDV)
      MZMV2 = CDV
      DO J = 1, 3
         IF (ABS((MZMV1(J)-MZMV2(J))/MZMV2(J)) >= DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1205
      MFMV4 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      MZMV1 = TO_ZM(MFMV4)
      MZMV2 = MFMV4
      DO J = 1, 3
         IF (ABS(MZMV1(J)-MZMV2(J)) /= 0) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1206
      MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      MZMV1 = TO_ZM(MIMV1)
      MZMV2 = MIMV1
      DO J = 1, 3
         IF (ABS(MZMV1(J)-MZMV2(J)) /= 0) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1207
      MZMV4 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV1 = TO_ZM(MZMV4)
      MZMV2 = MZMV4
      DO J = 1, 3
         IF (ABS(MZMV1(J)-MZMV2(J)) /= 0) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1208
      STV = (/ " 12.1123456789", "-34.2123456789", " 56.3123456789" /)
      MZMV1 = TO_ZM(STV)
      MZMV2 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      DO J = 1, 3
         IF (ABS(MZMV1(J)-MZMV2(J)) /= 0) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1209
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZMA2 = TO_ZM(JV2)
      MZMB2 = JV2
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MZMA2(J,K) == MZMB2(J,K))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1210
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZMA2 = TO_ZM(RV2)
      MZMB2 = RV2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((MZMA2(J,K)-MZMB2(J,K))/MZMB2(J,K)) >= RSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1211
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZMA2 = TO_ZM(DV2)
      MZMB2 = DV2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((MZMA2(J,K)-MZMB2(J,K))/MZMB2(J,K)) >= DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1212
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZMA2 = TO_ZM(CV2)
      MZMB2 = CV2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((MZMA2(J,K)-MZMB2(J,K))/MZMB2(J,K)) >= RSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1213
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZMA2 = TO_ZM(CDV2)
      MZMB2 = CDV2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((MZMA2(J,K)-MZMB2(J,K))/MZMB2(J,K)) >= DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1214
      DO J = 1, 3
         DO K = 1, 3
            MFMC(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMA2 = TO_ZM(MFMC)
      MZMB2 = MFMC
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS(MZMA2(J,K)-MZMB2(J,K)) /= 0) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1215
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMA2 = TO_ZM(MIMA2)
      MZMB2 = MIMA2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS(MZMA2(J,K)-MZMB2(J,K)) /= 0) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1216
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)),  &
                               TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMA2 = TO_ZM(MZMA2)
      MZMB2 = MZMA2
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS(MZMA2(J,K)-MZMB2(J,K)) /= 0) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1217
      STV2 = RESHAPE( (/ " 12.34 + 87.65 i", "-34.21 + 44.55 i", " 56.74 - 88.23 i",  &
                         " 23.11 - 97.53 i", "-36.46 - 83.37 i", " 66.38 + 72.15 i",  &
                         " 45.28 - 28.45 i", "-38.04 -  4.85 i", " 76.31 - 13.67 i"   &
                      /) , SHAPE = (/ 3,3 /) )
      MZMA2 = TO_ZM(STV2)
      MZMB2 = RESHAPE( (/ TO_ZM(" 12.34 + 87.65 i"), TO_ZM("-34.21 + 44.55 i"),  &
                          TO_ZM(" 56.74 - 88.23 i"), TO_ZM(" 23.11 - 97.53 i"),  &
                          TO_ZM("-36.46 - 83.37 i"), TO_ZM(" 66.38 + 72.15 i"),  &
                          TO_ZM(" 45.28 - 28.45 i"), TO_ZM("-38.04 -  4.85 i"),  &
                          TO_ZM(" 76.31 - 13.67 i")   &
                       /) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS(MZMA2(J,K)-MZMB2(J,K)) /= 0) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1218
      CALL FM_M2I(MFM1,J3)
      IF (TO_INT(MFM1) /= J3) CALL PRTERR(KW)

      NCASE = 1219
      CALL IM_M2I(MIM1,J3)
      IF (TO_INT(MIM1) /= J3) CALL PRTERR(KW)

      NCASE = 1220
      CALL ZM_M2I(MZM1,J3)
      IF (TO_INT(MZM1) /= J3) CALL PRTERR(KW)

      NCASE = 1221
      CALL FM_M2SP(MFM1,R3)
      IF (ABS((TO_SP(MFM1)-R3)/R3) > RSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1222
      CALL IM_M2DP(MIM1,D3)
      R3 = D3
      IF (ABS((TO_SP(MIM1)-R3)/R3) > RSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1223
      CALL ZM_REAL(MZM1,MFM4)
      CALL FM_M2SP(MFM4,R3)
      IF (ABS((TO_SP(MZM1)-R3)/R3) > RSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1224
      CALL FM_M2DP(MFM1,D3)
      IF (ABS((TO_DP(MFM1)-D3)/D3) > DSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1225
      CALL IM_M2DP(MIM1,D3)
      IF (ABS((TO_DP(MIM1)-D3)/D3) > DSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1226
      CALL ZM_REAL(MZM1,MFM4)
      CALL FM_M2DP(MFM4,D3)
      IF (ABS((TO_DP(MZM1)-D3)/D3) > DSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1227
      CALL FM_M2SP(MFM1,R3)
      C3 = R3
      IF (ABS((TO_SPZ(MFM1)-C3)/C3) > RSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1228
      CALL IM_M2DP(MIM1,D3)
      C3 = D3
      IF (ABS((TO_SPZ(MIM1)-C3)/C3) > RSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1229
      CALL ZM_M2Z(MZM1,C3)
      IF (ABS((TO_SPZ(MZM1)-C3)/C3) > RSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1230
      CALL FM_M2DP(MFM1,D3)
      CD3 = D3
      IF (ABS((TO_DPZ(MFM1)-CD3)/CD3) > DSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1231
      CALL IM_M2DP(MIM1,D3)
      CD3 = D3
      IF (ABS((TO_DPZ(MIM1)-CD3)/CD3) > DSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1232
      CALL ZM_REAL(MZM1,MFM4)
      CALL FM_M2DP(MFM4,D3)
      CALL ZM_IMAG(MZM1,MFM4)
      CALL FM_M2DP(MFM4,D4)
      CD3 = CMPLX( D3 , D4 , KIND(0.0D0) )
      IF (ABS((TO_DPZ(MZM1)-CD3)/CD3) > DSMALL) THEN
          CALL PRTERR(KW)
      ENDIF

      NCASE = 1233
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      DV = TO_INT(MFMV1)
      DO J = 1, 3
         IF (ABS((DV(J)-INT(MFMV1(J)))/INT(MFMV1(J))) > DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1234
      MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      DV = TO_INT(MIMV1)
      DO J = 1, 3
         IF (ABS((DV(J)-INT(MIMV1(J)))/INT(MIMV1(J))) > DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1235
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      DV = TO_INT(MZMV1)
      DO J = 1, 3
         IF (ABS((DV(J)-INT(REAL(MZMV1(J))))/INT(REAL(MZMV1(J)))) > DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1236
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DV2 = TO_INT(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((DV2(J,K)-INT(MFMA(J,K)))/INT(MFMA(J,K))) > DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1237
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DV2 = TO_INT(MIMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((DV2(J,K)-INT(MIMA2(J,K)))/INT(MIMA2(J,K))) > DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1238
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)),  &
                               TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DV2 = TO_INT(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((DV2(J,K)-INT(REAL(MZMA2(J,K))))/INT(REAL(MZMA2(J,K)))) > DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1239
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      DV = TO_SP(MFMV1)
      DO J = 1, 3
         IF (ABS((DV(J)-MFMV1(J))/MFMV1(J)) > RSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1240
      MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      DV = TO_SP(MIMV1)
      DO J = 1, 3
         IF (ABS((DV(J)-MIMV1(J))/MIMV1(J)) > RSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1241
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      DV = TO_SP(MZMV1)
      DO J = 1, 3
         IF (ABS((DV(J)-REAL(MZMV1(J)))/REAL(MZMV1(J))) > RSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1242
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DV2 = TO_SP(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((DV2(J,K)-MFMA(J,K))/MFMA(J,K)) > RSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1243
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DV2 = TO_SP(MIMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((DV2(J,K)-MIMA2(J,K))/MIMA2(J,K)) > RSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1244
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)),  &
                               TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DV2 = TO_SP(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((DV2(J,K)-REAL(MZMA2(J,K)))/REAL(MZMA2(J,K))) > RSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1245
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      DV = TO_DP(MFMV1)
      DO J = 1, 3
         IF (ABS((DV(J)-MFMV1(J))/MFMV1(J)) > DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1246
      MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      DV = TO_DP(MIMV1)
      DO J = 1, 3
         IF (ABS((DV(J)-MIMV1(J))/MIMV1(J)) > DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1247
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      DV = TO_DP(MZMV1)
      DO J = 1, 3
         IF (ABS((DV(J)-REAL(MZMV1(J)))/REAL(MZMV1(J))) > DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1248
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DV2 = TO_DP(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((DV2(J,K)-MFMA(J,K))/MFMA(J,K)) > DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1249
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DV2 = TO_DP(MIMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((DV2(J,K)-MIMA2(J,K))/MIMA2(J,K)) > DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1250
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)),  &
                               TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DV2 = TO_DP(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((DV2(J,K)-REAL(MZMA2(J,K)))/REAL(MZMA2(J,K))) > DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1251
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      CV = TO_SPZ(MFMV1)
      DO J = 1, 3
         IF (ABS((CV(J)-MFMV1(J))/MFMV1(J)) > RSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1252
      MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      CV = TO_SPZ(MIMV1)
      DO J = 1, 3
         IF (ABS((CV(J)-MIMV1(J))/MIMV1(J)) > RSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1253
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      CV = TO_SPZ(MZMV1)
      DO J = 1, 3
         IF (ABS((CV(J)-MZMV1(J))/MZMV1(J)) > RSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1254
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      CV2 = TO_SPZ(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((CV2(J,K)-MFMA(J,K))/MFMA(J,K)) > RSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1255
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      CV2 = TO_SPZ(MIMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((CV2(J,K)-MIMA2(J,K))/MIMA2(J,K)) > RSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1256
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)),  &
                               TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      CV2 = TO_SPZ(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((CV2(J,K)-MZMA2(J,K))/MZMA2(J,K)) > RSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1257
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') ,  &
                 TO_FM('56.3123456789') /)
      CDV = TO_DPZ(MFMV1)
      DO J = 1, 3
         IF (ABS((CDV(J)-MFMV1(J))/MFMV1(J)) > DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1258
      MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
      CDV = TO_DPZ(MIMV1)
      DO J = 1, 3
         IF (ABS((CDV(J)-MIMV1(J))/MIMV1(J)) > DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1259
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      CDV = TO_DPZ(MZMV1)
      DO J = 1, 3
         IF (ABS((CDV(J)-MZMV1(J))/MZMV1(J)) > DSMALL) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1260
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      CDV2 = TO_DPZ(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((CDV2(J,K)-MFMA(J,K))/MFMA(J,K)) > DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1261
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      CDV2 = TO_DPZ(MIMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((CDV2(J,K)-MIMA2(J,K))/MIMA2(J,K)) > DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1262
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)),  &
                               TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      CDV2 = TO_DPZ(MZMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (ABS((CDV2(J,K)-MZMA2(J,K))/MZMA2(J,K)) > DSMALL) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      END SUBROUTINE TEST41

      SUBROUTINE TEST42

!             Test the derived-type interface routines that are not used elsewhere in this program.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the derived type ADDI, ..., Z2M interfaces.')")

      RSMALL = EPSILON(1.0)*100.0
      DSMALL = EPSILON(1.0D0)*100.0
      MSMALL = EPSILON(TO_FM(1))*10000.0

      NCASE = 1263
      MFM3 = MFM1 + 123
      MFM4 = MFM1
      CALL FM_ADDI(MFM4,123)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1264
      CALL FM_COSH_SINH(MFM1,MFM4,MFM3)
      MFM3 = COSH(MFM1)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1265
      CALL FM_COSH_SINH(MFM1,MFM3,MFM4)
      MFM3 = SINH(MFM1)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1266
      CALL FM_COS_SIN(MFM1,MFM4,MFM3)
      MFM3 = COS(MFM1)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1267
      CALL FM_COS_SIN(MFM1,MFM3,MFM4)
      MFM3 = SIN(MFM1)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1268
      MFM3 = MFM1 / 123
      CALL FM_DIVI(MFM1,123,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1269
      MFM3 = MFM1 / 123
      MFM4 = MFM1
      CALL FM_DIVI_R1(MFM4,123)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1270
      MFM3 = 123.45D0
      CALL FM_DPM(123.45D0,MFM4)
      IF (ABS((MFM3-MFM4)/MFM4) > DSMALL) CALL PRTERR(KW)

      NCASE = 1271
      CALL FM_FORM('F70.56',MFM1,STRING)
      CALL FM_ST2M(STRING(1:70),MFM4)
      IF (ABS((MFM1-MFM4)/MFM4) > MSMALL) CALL PRTERR(KW)

      NCASE = 1272
      STRING = FM_FORMAT('F70.56',MFM1)
      CALL FM_ST2M(STRING(1:70),MFM4)
      IF (ABS((MFM1-MFM4)/MFM4) > MSMALL) CALL PRTERR(KW)

      NCASE = 1273
      MFM3 = MFM1 ** 123
      CALL FM_IPOWER(MFM1,123,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1274
      MFM3 = LOG(TO_FM(123))
      CALL FM_LNI(123,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1275
      D4 = MFM1
      CALL FM_M2DP(MFM1,D5)
      IF (ABS((D4-D5)/D4) > DSMALL) CALL PRTERR(KW)

      NCASE = 1276
      J4 = MFM1
      CALL FM_M2I(MFM1,J5)
      IF (J4 /= J5) CALL PRTERR(KW)

      NCASE = 1277
      R4 = MFM1
      CALL FM_M2SP(MFM1,R5)
      IF (ABS((R4-R5)/R4) > RSMALL) CALL PRTERR(KW)

      NCASE = 1278
      MFM3 = 2.67
      CALL FM_MOD(MFM1,MFM3,MFM4)
      MFM3 = MOD(MFM1,MFM3)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1279
      CALL FM_PI(MFM4)
      MFM3 = 4*ATAN(TO_FM(1))
      IF (ABS((MFM3-MFM4)/MFM4) > MSMALL) CALL PRTERR(KW)

      NCASE = 1280
      MFM3 = MFM1 ** (TO_FM(1)/TO_FM(3))
      CALL FM_RATIONAL_POWER(MFM1,1,3,MFM4)
      IF (ABS((MFM3-MFM4)/MFM4) > MSMALL) CALL PRTERR(KW)

      NCASE = 1281
      CALL FM_SQR(MFM1,MFM4)
      MFM3 = MFM1*MFM1
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1282
      CALL FM_EQ(MFM1,MFM4)
      CALL FM_SQR_R1(MFM4)
      MFM3 = MFM1*MFM1
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1283
      MIM3 = MIM1 / 13
      CALL IM_DIVI(MIM1,13,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1284
      MIM3 = 13
      CALL IM_DIVR(MIM1,MIM3,MIM5,MIM4)
      MIM3 = MOD(MIM1,MIM3)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1285
      MIM3 = 13
      CALL IM_DIVR(MIM1,MIM3,MIM5,MIM4)
      CALL IM_EQ(MIM5,MIM3)
      MIM4 = MIM1 / 13
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1286
      MIM3 = MIM1 / 13
      CALL IM_DVIR(MIM1,13,MIM4,J5)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1287
      J4 = MOD(MIM1,TO_IM(13))
      CALL IM_DVIR(MIM1,13,MIM4,J5)
      IF (J4 /= J5) CALL PRTERR(KW)

      NCASE = 1288
      CALL IM_FORM('I70',MIM1,STRING)
      CALL IM_ST2M(STRING(1:70),MIM4)
      IF (.NOT.(MIM1 == MIM4)) CALL PRTERR(KW)

      NCASE = 1289
      STRING = IM_FORMAT('I70',MIM1)
      CALL IM_ST2M(STRING(1:70),MIM4)
      IF (.NOT.(MIM1 == MIM4)) CALL PRTERR(KW)

      NCASE = 1290
      MIM3 = 40833
      MIM4 = 16042
      CALL IM_GCD(MIM3,MIM4,MIM5)
      CALL IM_EQ(MIM5,MIM4)
      IF (.NOT.(MIM4 == 13)) CALL PRTERR(KW)

      NCASE = 1291
      MIM3 = 40833
      MIM4 = 16042
      MIM4 = GCD(MIM3,MIM4)
      IF (.NOT.(MIM4 == 13)) CALL PRTERR(KW)

      NCASE = 1292
      D4 = MIM1
      CALL IM_M2DP(MIM1,D5)
      IF (ABS((D4-D5)/D4) > DSMALL) CALL PRTERR(KW)

      NCASE = 1293
      J4 = MIM1
      CALL IM_M2I(MIM1,J5)
      IF (J4 /= J5) CALL PRTERR(KW)

      NCASE = 1294
      MIM3 = 6
      CALL IM_MOD(MIM1,MIM3,MIM4)
      MIM3 = MOD(MIM1,MIM3)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1295
      MIM3 = MIM1 * 123
      CALL IM_MPYI(MIM1,123,MIM4)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1296
      MIM2 = 3141
      MIM3 = 133
      CALL IM_MPY_MOD(MIM1,MIM2,MIM3,MIM4)
      MIM3 = MOD(MIM1*MIM2,MIM3)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1297
      MIM2 = 3141
      MIM3 = 133
      MIM4 = MULTIPLY_MOD(MIM1,MIM2,MIM3)
      MIM3 = MOD(MIM1*MIM2,MIM3)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1298
      MIM2 = 31
      MIM3 = 147
      CALL IM_POWER_MOD(MIM1,MIM2,MIM3,MIM4)
      MIM3 = MOD(MIM1**MIM2,MIM3)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1299
      MIM2 = 31
      MIM3 = 147
      MIM4 = POWER_MOD(MIM1,MIM2,MIM3)
      MIM3 = MOD(MIM1**MIM2,MIM3)
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
      CALL IM_ST2M('-602',MIM2)

      NCASE = 1300
      CALL IM_SQR(MIM1,MIM4)
      MIM3 = MIM1*MIM1
      IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)

      NCASE = 1301
      MZM3 = MZM1 + 123
      MZM4 = MZM1
      CALL ZM_ADDI(MZM4,123)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1302
      MFM3 = ATAN2(AIMAG(MZM1),REAL(MZM1))
      CALL ZM_ARG(MZM1,MFM4)
      IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)

      NCASE = 1303
      CALL ZM_COSH_SINH(MZM1,MZM4,MZM3)
      MZM3 = COSH(MZM1)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1304
      CALL ZM_COSH_SINH(MZM1,MZM3,MZM4)
      MZM3 = SINH(MZM1)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1305
      CALL ZM_COS_SIN(MZM1,MZM4,MZM3)
      MZM3 = COS(MZM1)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1306
      CALL ZM_COS_SIN(MZM1,MZM3,MZM4)
      MZM3 = SIN(MZM1)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1307
      CALL ZM_FORM('F35.26','F35.26',MZM1,STRING)
      CALL ZM_ST2M(STRING(1:75),MZM4)
      IF (ABS((MZM1-MZM4)/MZM4) > MSMALL) CALL PRTERR(KW)

      NCASE = 1308
      STRING = ZM_FORMAT('F35.26','F35.26',MZM1)
      CALL ZM_ST2M(STRING(1:75),MZM4)
      IF (ABS((MZM1-MZM4)/MZM4) > MSMALL) CALL PRTERR(KW)

      NCASE = 1309
      MZM3 = TO_ZM('123-456i')
      CALL ZM_2I2M(123,-456,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1310
      MZM3 = MZM1 ** 123
      CALL ZM_IPOWER(MZM1,123,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1311
      J4 = MZM1
      CALL ZM_M2I(MZM1,J5)
      IF (J4 /= J5) CALL PRTERR(KW)

      NCASE = 1312
      C4 = MZM1
      CALL ZM_M2Z(MZM1,C5)
      IF (ABS((C4-C5)/C4) > RSMALL) CALL PRTERR(KW)

      NCASE = 1313
      MZM3 = MZM1 * 123
      CALL ZM_MPYI(MZM1,123,MZM4)
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1314
      MZM3 = MZM1 ** (TO_ZM(1)/TO_ZM(3))
      CALL ZM_RATIONAL_POWER(MZM1,1,3,MZM4)
      IF (ABS((MZM3-MZM4)/MZM4) > MSMALL) CALL PRTERR(KW)

      NCASE = 1315
      CALL ZM_SQR(MZM1,MZM4)
      MZM3 = MZM1*MZM1
      IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)

      NCASE = 1316
      MZM3 = C2
      CALL ZM_Z2M(C2,MZM4)
      IF (ABS((MZM3-MZM4)/MZM3) > RSMALL) CALL PRTERR(KW)

      END SUBROUTINE TEST42

      SUBROUTINE TEST43

!  Test Bernoulli numbers, Pochhammer's function, Euler's constant.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing Bernoulli, Pochhammer, Euler.')")

      NCASE = 1317
      M_A = 1
      CALL FM_BERN(10,M_A,M_C)
      M_D = TO_FM('7.5757575757575757575757575757575757575757575757575758M-2')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1318
      M_A = 1
      CALL FM_BERN(0,M_A,M_C)
      M_D = TO_FM('1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1319
      M_A = 1
      CALL FM_BERN(1,M_A,M_C)
      M_D = TO_FM('-0.5')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1320
      M_A = 1
      CALL FM_BERN(41,M_A,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1321
      M_A = 0
      CALL FM_BERN(52,M_A,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1322
      M_A = TO_FM('.7699115044247787610619469026548672566371681415929204')
      CALL FM_BERN(102,M_A,M_C)
      M_D = TO_FM('5.7022917356035929245914353639470138260075545712953255M+80')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1323
      M_A = TO_FM('.7699115044247787610619469026548672566371681415929204')
      CALL FM_BERN(76,M_A,M_C)
      M_D = TO_FM('-6.3274121765674850311763600458139008604123253720098077M+50')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1324
      CALL FM_BERNOULLI(76,M_C)
      M_D = TO_FM('-8.2183629419784575692290653468617333014550892762886003M+50')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1325
      M_C = BERNOULLI(278)
      M_D = TO_FM('5.4809571213188766395120969944139922843271762639028329M+338')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1326
      M_C = BERNOULLI(10**5)
      M_D = TO_FM('-5.8222943146133508236497045360612887555320691004307968525M+376755')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1327
      M_A = TO_FM('.7699115044247787610619469026548672566371681415929204')
      M_C = BERNOULLI(76)*M_A
      M_D = TO_FM('-6.3274121765674850311763600458139008604123253720098077M+50')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1328
      M_A = 76
      M_C = BERNOULLI_FM1(76)
      M_D = TO_FM('-8.218362941978457569229065346861733301455089276288600333M+50')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1329
      M_A = 78
      M_C = BERNOULLI_FM2(78)
      M_D = TO_FM('1.250290432716699301673233982970289552417719636444847750M+53')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1330
      M_A = 80
      M_C = BERNOULLI_IM1(80)
      M_D = TO_FM('-2.001558323324837027492532919881329876872422013282591592M+55')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1331
      M_A = 82
      M_C = BERNOULLI_IM2(82)
      M_D = TO_FM('3.367498291536437423339667690333875301621959894719384367M+57')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1332
      M_A = 84
      M_C = BERNOULLI_ZM1(84)
      M_D = TO_FM('-5.947097050313544771866049684405154084057907156510690499M+59')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1333
      M_A = 86
      M_C = BERNOULLI_ZM2(86)
      M_D = TO_FM('1.101191032362797755956413079043769160463051144422314886M+62')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1334
      M_A = TO_FM('769.9115044247787610619469026548672566371681415929204')
      CALL FM_POCH(M_A,10,M_C)
      M_D = TO_FM('7.7568981408767238023000514593534249181767332686451635M+28')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1335
      M_A = TO_FM('7699.115044247787610619469026548672566371681415929204')
      CALL FM_POCH(M_A,2222,M_C)
      M_D = TO_FM('1.330632198579290013040965245531889745992136035131794M+8763')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1336
      M_A = TO_FM('-7')
      CALL FM_POCH(M_A,12,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1337
      M_A = TO_FM('7.7568981408767238023000514593534249181767332686451635M+281')
      CALL FM_POCH(M_A,6,M_C)
      M_D = TO_FM('2.178354371001981973863113631260449017724481835653894M+1691')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1338
      M_A = TO_FM('7.7568981408767238023000514593534249181767332686451635M-281')
      CALL FM_POCH(M_A,8,M_C)
      M_D = TO_FM('3.9094766630018687963592259355141261587610735673971624M-277')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1339
      M_A = TO_FM('7.7568981408767238023000514593534249181767332686451635M-281')
      CALL FM_POCH(M_A,1,M_C)
      M_D = TO_FM('7.7568981408767238023000514593534249181767332686451635M-281')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1340
      M_A = TO_FM('7.7568981408767238023000514593534249181767332686451635M-281')
      CALL FM_POCH(M_A,0,M_C)
      M_D = TO_FM('1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1341
      M_A = TO_FM('0')
      CALL FM_POCH(M_A,8,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1342
      M_A = TO_FM('769.9115044247787610619469026548672566371681415929204')
      M_C = POCHHAMMER(M_A,10)
      M_D = TO_FM('7.7568981408767238023000514593534249181767332686451635M+28')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1343
      CALL FM_EULER(M_C)
      M_D = TO_FM('.5772156649015328606065120900824024310421593359399236')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' EULER',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1344
      CALL FMEULER(M_C%MFM)
      M_D = TO_FM('.5772156649015328606065120900824024310421593359399236')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' EULER',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1345
      NDGSAV = NDIG
      NDIG = INT(1785*DLOGTN/DLOGMB)+2
      CALL FM_EULER(M_C)
      M_D = TO_FM(  &
      '.5772156649015328606065120900824024310421593359399235988057672348848'// &
      '67726777664670936947063291746749514631447249807082480960504014486542'// &
      '83622417399764492353625350033374293733773767394279259525824709491600'// &
      '87352039481656708532331517766115286211995015079847937450857057400299'// &
      '21354786146694029604325421519058775535267331399254012967420513754139'// &
      '54911168510280798423487758720503843109399736137255306088933126760017'// &
      '24795378367592713515772261027349291394079843010341777177808815495706'// &
      '61075010161916633401522789358679654972520362128792265559536696281763'// &
      '88792726801324310104765059637039473949576389065729679296010090151251'// &
      '95950922243501409349871228247949747195646976318506676129063811051824'// &
      '19744486783638086174945516989279230187739107294578155431600500218284'// &
      '40960537724342032854783670151773943987003023703395183286900015581939'// &
      '88042707411542227819716523011073565833967348717650491941812300040654'// &
      '69314299929777956930310050308630341856980323108369164002589297089098'// &
      '54868257773642882539549258736295961332985747393023734388470703702844'// &
      '12920166417850248733379080562754998434590761643167103146710722370021'// &
      '81074504441866475913480366902553245862544222534518138791243457350136'// &
      '12977822782881489459098638460062931694718871495875254923664935204732'// &
      '43641097268276160877595088095126208404544477992299157248292516251278'// &
      '42765965708321461029821461795195795909592270420898962797125536321794'// &
      '88737642106606070659825619901028807561251991375116782176436190570584'// &
      '40783573501580056077457934213144988500786415171615194565706170432450'// &
      '75008168705230789093704614306684817916496842549150496724312183783875'// &
      '35648949508684541023406016225085155838672349441878804409407701068837'// &
      '95111307872023426395226920971608856908382511378712836820491178925944'// &
      '78486199118529391029309905925526691727446892044386971114717457157457'// &
      '3203935209122316085086828')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= MAX(TO_FM('1.0E-1785'),10*EPSILON(M_C)))) THEN
          CALL ERRPRT_FM(' EULER',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      NDIG = NDGSAV

      RETURN
      END SUBROUTINE TEST43

      FUNCTION BERNOULLI_FM1(N)

!  Seidel's recurrence for T(n).
!  This uses only addition of integers.
!  B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)

      USE FMZM
      IMPLICIT NONE
      INTEGER :: J,K,N
      TYPE (FM) :: BERNOULLI_FM1
      TYPE (FM), ALLOCATABLE :: T(:)
      CALL FM_ENTER_USER_FUNCTION(BERNOULLI_FM1)
      ALLOCATE(T( -N/2 : N/2 ),STAT=J)
      IF (J /= 0) THEN
          WRITE (*,"(/' Error in BERNOULLI_FM1.  Unable to allocate T with size ',I8/)") N
          STOP
      ENDIF

!             Initialize.

      T = 0
      T(-1:0) = 2
      T(1) = 1

!             Recurrence.

      DO J = 5, N, 2

!             Row J of the table is filled left to right.

         DO K = -J/2 + 2 , J/2
            T(K) = T(K-1) + T(K)
         ENDDO

!             Row J+1 of the table is filled right to left.

         DO K = J/2 - 1 , -J/2 , -1
            T(K) = T(K+1) + T(K)
         ENDDO
      ENDDO
      T(0) = TO_FM(2)**N
      BERNOULLI_FM1 = (-1)**(N/2) * ( N / ( T(0) - T(0)**2 ) ) * T(-N/2+1)
      CALL FM_DEALLOCATE(T)
      DEALLOCATE(T)
      CALL FM_EXIT_USER_FUNCTION(BERNOULLI_FM1)
      END FUNCTION BERNOULLI_FM1

      FUNCTION BERNOULLI_FM2(N)

!  Seidel's recurrence for T(n).
!  This uses only addition of integers.
!  B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)

      USE FMZM
      IMPLICIT NONE
      INTEGER :: J,K,N
      TYPE (FM) :: BERNOULLI_FM2
      TYPE (FM), ALLOCATABLE :: T(:,:)
      CALL FM_ENTER_USER_FUNCTION(BERNOULLI_FM2)
      ALLOCATE(T( 2 , -N/2 : N/2 ),STAT=J)
      IF (J /= 0) THEN
          WRITE (*,"(/' Error in BERNOULLI_FM2.  Unable to allocate T with size ',I8/)") N
          STOP
      ENDIF

!             Initialize.

      T = 0
      T(1,-1:0) = 2
      T(1,1) = 1

!             Recurrence.

      DO J = 5, N, 2

!             Row J of the table is filled left to right.

         DO K = -J/2 + 1 , J/2
            T(2,K) = T(2,K-1) + T(1,K)
         ENDDO

!             Row J+1 of the table is filled right to left.

         DO K = J/2 , -J/2 , -1
            T(1,K) = T(1,K+1) + T(2,K)
         ENDDO
      ENDDO
      T(1,0) = TO_FM(2)**N
      BERNOULLI_FM2 = (-1)**(N/2) * ( N / ( T(1,0) - T(1,0)**2 ) ) * T(1,-N/2+1)
      CALL FM_DEALLOCATE(T)
      DEALLOCATE(T)
      CALL FM_EXIT_USER_FUNCTION(BERNOULLI_FM2)
      END FUNCTION BERNOULLI_FM2

      FUNCTION BERNOULLI_IM1(N)

!  Seidel's recurrence for T(n).
!  This uses only addition of integers.
!  B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)

      USE FMZM
      IMPLICIT NONE
      INTEGER :: J,K,N
      TYPE (FM) :: BERNOULLI_IM1
      TYPE (IM), ALLOCATABLE :: T(:)
      CALL FM_ENTER_USER_FUNCTION(BERNOULLI_IM1)
      ALLOCATE(T( -N/2 : N/2 ),STAT=J)
      IF (J /= 0) THEN
          WRITE (*,"(/' Error in BERNOULLI_IM1.  Unable to allocate T with size ',I8/)") N
          STOP
      ENDIF

!             Initialize.

      T = 0
      T(-1:0) = 2
      T(1) = 1

!             Recurrence.

      DO J = 5, N, 2

!             Row J of the table is filled left to right.

         DO K = -J/2 + 2 , J/2
            T(K) = T(K-1) + T(K)
         ENDDO

!             Row J+1 of the table is filled right to left.

         DO K = J/2 - 1 , -J/2 , -1
            T(K) = T(K+1) + T(K)
         ENDDO
      ENDDO
      T(0) = TO_FM(2)**N
      BERNOULLI_IM1 = (-1)**(N/2) * ( TO_FM(N) / ( T(0) - T(0)**2 ) ) * T(-N/2+1)
      CALL FM_DEALLOCATE(T)
      DEALLOCATE(T)
      CALL FM_EXIT_USER_FUNCTION(BERNOULLI_IM1)
      END FUNCTION BERNOULLI_IM1

      FUNCTION BERNOULLI_IM2(N)

!  Seidel's recurrence for T(n).
!  This uses only addition of integers.
!  B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)

      USE FMZM
      IMPLICIT NONE
      INTEGER :: J,K,N
      TYPE (FM) :: BERNOULLI_IM2
      TYPE (IM), ALLOCATABLE :: T(:,:)
      CALL FM_ENTER_USER_FUNCTION(BERNOULLI_IM2)
      ALLOCATE(T( 2 , -N/2 : N/2 ),STAT=J)
      IF (J /= 0) THEN
          WRITE (*,"(/' Error in BERNOULLI_IM2.  Unable to allocate T with size ',I8/)") N
          STOP
      ENDIF

!             Initialize.

      T = 0
      T(1,-1:0) = 2
      T(1,1) = 1

!             Recurrence.

      DO J = 5, N, 2

!             Row J of the table is filled left to right.

         DO K = -J/2 + 1 , J/2
            T(2,K) = T(2,K-1) + T(1,K)
         ENDDO

!             Row J+1 of the table is filled right to left.

         DO K = J/2 , -J/2 , -1
            T(1,K) = T(1,K+1) + T(2,K)
         ENDDO
      ENDDO
      T(1,0) = TO_FM(2)**N
      BERNOULLI_IM2 = (-1)**(N/2) * ( TO_FM(N) / ( T(1,0) - T(1,0)**2 ) ) * T(1,-N/2+1)
      CALL FM_DEALLOCATE(T)
      DEALLOCATE(T)
      CALL FM_EXIT_USER_FUNCTION(BERNOULLI_IM2)
      END FUNCTION BERNOULLI_IM2

      FUNCTION BERNOULLI_ZM1(N)

!  Seidel's recurrence for T(n).
!  This uses only addition of integers.
!  B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)

      USE FMZM
      IMPLICIT NONE
      INTEGER :: J,K,N
      TYPE (FM) :: BERNOULLI_ZM1
      TYPE (ZM), ALLOCATABLE :: T(:)
      CALL FM_ENTER_USER_FUNCTION(BERNOULLI_ZM1)
      ALLOCATE(T( -N/2 : N/2 ),STAT=J)
      IF (J /= 0) THEN
          WRITE (*,"(/' Error in BERNOULLI_ZM1.  Unable to allocate T with size ',I8/)") N
          STOP
      ENDIF

!             Initialize.

      T = 0
      T(-1:0) = 2
      T(1) = 1

!             Recurrence.

      DO J = 5, N, 2

!             Row J of the table is filled left to right.

         DO K = -J/2 + 2 , J/2
            T(K) = T(K-1) + T(K)
         ENDDO

!             Row J+1 of the table is filled right to left.

         DO K = J/2 - 1 , -J/2 , -1
            T(K) = T(K+1) + T(K)
         ENDDO
      ENDDO
      T(0) = TO_FM(2)**N
      BERNOULLI_ZM1 = (-1)**(N/2) * ( TO_FM(N) / ( T(0) - T(0)**2 ) ) * T(-N/2+1)
      CALL FM_DEALLOCATE(T)
      DEALLOCATE(T)
      CALL FM_EXIT_USER_FUNCTION(BERNOULLI_ZM1)
      END FUNCTION BERNOULLI_ZM1

      FUNCTION BERNOULLI_ZM2(N)

!  Seidel's recurrence for T(n).
!  This uses only addition of integers.
!  B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)

      USE FMZM
      IMPLICIT NONE
      INTEGER :: J,K,N
      TYPE (FM) :: BERNOULLI_ZM2
      TYPE (ZM), ALLOCATABLE :: T(:,:)
      CALL FM_ENTER_USER_FUNCTION(BERNOULLI_ZM2)
      ALLOCATE(T( 2 , -N/2 : N/2 ),STAT=J)
      IF (J /= 0) THEN
          WRITE (*,"(/' Error in BERNOULLI_ZM2.  Unable to allocate T with size ',I8/)") N
          STOP
      ENDIF

!             Initialize.

      T = 0
      T(1,-1:0) = 2
      T(1,1) = 1

!             Recurrence.

      DO J = 5, N, 2

!             Row J of the table is filled left to right.

         DO K = -J/2 + 1 , J/2
            T(2,K) = T(2,K-1) + T(1,K)
         ENDDO

!             Row J+1 of the table is filled right to left.

         DO K = J/2 , -J/2 , -1
            T(1,K) = T(1,K+1) + T(2,K)
         ENDDO
      ENDDO
      T(1,0) = TO_FM(2)**N
      BERNOULLI_ZM2 = (-1)**(N/2) * ( TO_FM(N) / ( T(1,0) - T(1,0)**2 ) ) * T(1,-N/2+1)
      CALL FM_DEALLOCATE(T)
      DEALLOCATE(T)
      CALL FM_EXIT_USER_FUNCTION(BERNOULLI_ZM2)
      END FUNCTION BERNOULLI_ZM2

      SUBROUTINE TEST44

!  Test Gamma, Factorial, Log(Gamma), Beta, Binomial.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing Gamma, Factorial, Log(Gamma), Beta, Binomial.')")

      NCASE = 1346
      M_A = 19
      CALL FM_GAM(M_A,M_C)
      M_D = TO_FM('6.402373705728M+15')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('  GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1347
      M_A = TO_FM('.7699115044247787610619469026548672566371681415929204')
      CALL FM_GAM(M_A,M_C)
      M_D = TO_FM('1.1998023858495967876496039855917100290498970370440326')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('  GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1348
      M_A = TO_FM('-.7699115044247787610619469026548672566371681415929204')
      CALL FM_GAM(M_A,M_C)
      M_D = TO_FM('-5.14110071322331700055471385717142758748739973201063050214')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('  GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1349
      M_A = TO_FM('5.7699115044247787610619469026548672566371681415929204')
      CALL FM_GAM(M_A,M_C)
      M_D = TO_FM('8.1434691207877806133071511233406796488474685081500979M+1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('  GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1350
      M_A = TO_FM('7.7568981408767238023000514593534249181767332686451635M-281')
      CALL FM_GAM(M_A,M_C)
      M_D = TO_FM('1.2891751081921193691625844770542239587773115818085396M+280')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('  GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1351
      M_A = TO_FM('2')
      CALL FM_GAM(M_A,M_C)
      M_D = TO_FM('1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('  GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1352
      M_A = TO_FM('5.7699115044247787610619469026548672566371681415929204')
      M_C = GAMMA(M_A)
      M_D = TO_FM('8.1434691207877806133071511233406796488474685081500979M+1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('  GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1353
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = GAMMA(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == GAMMA(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1354
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = GAMMA(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == GAMMA(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1355
      M_A = 33
      CALL FM_FACT(M_A,M_C)
      M_D = TO_FM('8.68331761881188649551819440128M+36')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' FACT ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1356
      M_A = TO_FM('769.9115044247787610619469026548672566371681415929204')
      CALL FM_FACT(M_A,M_C)
      M_D = TO_FM('5.998259003357134762219307127916529472560301341339449M+1889')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' FACT ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1357
      M_A = TO_FM('769.9115044247787610619469026548672566371681415929204')
      M_C = FACTORIAL(M_A)
      M_D = TO_FM('5.998259003357134762219307127916529472560301341339449M+1889')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' FACT ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1358
      CALL IMFACT(0,MA)
      CALL IMI2M(1,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPRTIM('IMFACT',MA,'MA',MC,'MC')
      ENDIF

      NCASE = 1359
      CALL IM_FACT(7,M_J)
      CALL IM_I2M(5040,M_K)
      IF (.NOT.(M_J == M_K)) THEN
          CALL ERRPRT_IM('IM_FACT',M_J,'M_J',M_K,'M_K')
      ENDIF

      NCASE = 1360
      CALL IM_FACT(12,M_J)
      CALL IM_I2M(479001600,M_K)
      IF (.NOT.(M_J == M_K)) THEN
          CALL ERRPRT_IM('IM_FACT',M_J,'M_J',M_K,'M_K')
      ENDIF

      NCASE = 1361
      M_J = FACTORIAL(50)
      M_K = TO_IM('30414093201713378043612608166064768844377641568960512000000000000')
      IF (.NOT.(M_J == M_K)) THEN
          CALL ERRPRT_IM(' FACT ',M_J,'M_J',M_K,'M_K')
      ENDIF

      NCASE = 1362
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = FACTORIAL(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == FACTORIAL(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1363
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = FACTORIAL(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == FACTORIAL(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1364
      M_J = 56
      M_J = FACTORIAL(M_J)
      M_K = TO_IM('710998587804863451854045647463724949736497978881168458687447040000000000000')
      IF (.NOT.(M_J == M_K)) THEN
          CALL ERRPRT_IM(' FACT ',M_J,'M_J',M_K,'M_K')
      ENDIF

      NCASE = 1365
      MIMV1 = TO_IM( (/ 12 , 123 , 456 /) )
      MIMV2 = FACTORIAL(MIMV1)
      DO J = 1, 3
         IF (.NOT.(MIMV2(J) == FACTORIAL(MIMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1366
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_IM(25+31*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIMB2 = FACTORIAL(MIMA2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMB2(J,K) == FACTORIAL(MIMA2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1367
      JV = (/ 12 , 123 , 456 /)
      MIMV2 = FACTORIAL(JV)
      DO J = 1, 3
         IF (.NOT.(MIMV2(J) == FACTORIAL(JV(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1368
      DO J = 1, 3
         DO K = 1, 3
            JV2(J,K) = 25+31*(J+3*(K-1))
         ENDDO
      ENDDO
      MIMB2 = FACTORIAL(JV2)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MIMB2(J,K) == FACTORIAL(JV2(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1369
      M_A = TO_FM('1.0M-222')
      CALL FM_LNGM(M_A,M_C)
      M_D = TO_FM('5.1117389064467814185199410293992885408744453047558760M+2')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' LNGM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1370
      M_A = TO_FM('2')
      CALL FM_LNGM(M_A,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' LNGM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1371
      M_A = TO_FM('33')
      CALL FM_LNGM(M_A,M_C)
      M_D = TO_FM('8.1557959456115037178502968666011206687099284403417368M+1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' LNGM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1372
      M_A = TO_FM('2.00000000000000000001')
      CALL FM_LNGM(M_A,M_C)
      M_D = TO_FM('4.2278433509846713939671258025183870114019600466320121M-21')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' LNGM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1373
      M_C = LOG_GAMMA(TO_FM('33'))
      M_D = TO_FM('8.1557959456115037178502968666011206687099284403417368M+1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' LNGM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1374
      MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
      MFMV2 = LOG_GAMMA(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == LOG_GAMMA(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1375
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = LOG_GAMMA(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == LOG_GAMMA(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 1376
      M_A = TO_FM('2.0706137739520290320140007735608464643737932737070189M-223')
      M_B = TO_FM('.78')
      CALL FM_BETA(M_A,M_B,M_C)
      M_D = TO_FM('4.8294858876137637017880452468052846823385248996130407M+222')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1377
      M_A = TO_FM('.78')
      M_B = TO_FM('2.0706137739520290320140007735608464643737932737070189M-223')
      CALL FM_BETA(M_A,M_B,M_C)
      M_D = TO_FM('4.8294858876137637017880452468052846823385248996130407M+222')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1378
      M_A = TO_FM('-4.5')
      M_B = TO_FM('4.5')
      CALL FM_BETA(M_A,M_B,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1379
      M_A = TO_FM('-5.5')
      M_B = TO_FM('4.5')
      CALL FM_BETA(M_A,M_B,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1380
      M_A = TO_FM('10')
      M_B = TO_FM('4')
      CALL FM_BETA(M_A,M_B,M_C)
      M_D = TO_FM('3.4965034965034965034965034965034965034965034965034965M-4')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1381
      M_A = TO_FM('1.0M+1234')
      M_B = TO_FM('2.2')
      CALL FM_BETA(M_A,M_B,M_C)
      M_D = TO_FM('1.746239267231954787655429292265211001580693244013921M-2715')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1382
      M_A = TO_FM('10')
      M_B = TO_FM('5.3')
      CALL FM_BETA(M_A,M_B,M_C)
      M_D = TO_FM('7.0836036771097107530120640698518155187687458162734679M-5')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1383
      M_A = TO_FM('10.3')
      M_B = TO_FM('5')
      CALL FM_BETA(M_A,M_B,M_C)
      M_D = TO_FM('8.8146035423244390793072072569173028531206477712519934M-5')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1384
      M_A = TO_FM('10.3')
      M_B = TO_FM('5')
      M_C = BETA(M_A,M_B)
      M_D = TO_FM('8.8146035423244390793072072569173028531206477712519934M-5')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1385
      M_A = TO_FM('12.5')
      M_B = TO_FM('0')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1386
      M_A = TO_FM('5')
      M_B = TO_FM('-2')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1387
      M_A = TO_FM('12.5')
      M_B = TO_FM('12.5')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1388
      M_A = TO_FM('-4.5')
      M_B = TO_FM('4.5')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1389
      M_A = TO_FM('-4.5')
      M_B = TO_FM('4.5')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1390
      M_A = TO_FM('-10')
      M_B = TO_FM('3')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('-220')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1391
      M_A = TO_FM('52')
      M_B = TO_FM('5')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('2.59896M+6')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1392
      M_A = TO_FM('1.0M+1234')
      M_B = TO_FM('7')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('1.984126984126984126984126984126984126984126984126984M+8634')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1393
      M_A = TO_FM('1.0M+123')
      M_B = TO_FM('2.2')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('1.6423797032130683531106846289429264567307029528308099M+270')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1394
      M_A = TO_FM('1.0M-100')
      M_B = TO_FM('4')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('-2.5M-101')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1395
      M_A = TO_FM('1.0M+123')
      M_B = TO_FM('2.2')
      M_C = BINOMIAL(M_A,M_B)
      M_D = TO_FM('1.6423797032130683531106846289429264567307029528308099M+270')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      RETURN
      END SUBROUTINE TEST44

      END MODULE TEST_B


      MODULE TEST_C
      USE TEST_VARS

      CONTAINS

      SUBROUTINE TEST45

!  Test Incomplete Gamma, Incomplete Beta.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing Incomplete Gamma, Incomplete Beta.')")

      NCASE = 1396
      M_A = TO_FM('2.0706137739520290320140007735608464643737932737070189M-145')
      M_B = TO_FM('.34')
      CALL FM_IGM1(M_A,M_B,M_C)
      M_D = TO_FM('4.8294858876137637017880452468052846823385248996130407M+144')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1397
      M_A = TO_FM('1.0E-50')
      M_B = TO_FM('1.0E+555')
      CALL FM_IGM1(M_A,M_B,M_C)
      M_D = TO_FM('9.9999999999999999999999999999999999999999999999999423M+49')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1398
      M_A = TO_FM('1.2')
      M_B = TO_FM('2.3')
      CALL FM_IGM1(M_A,M_B,M_C)
      M_D = TO_FM('7.9163089830797686672658085698101181778608009481363580M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1399
      M_A = TO_FM('23.4')
      M_B = TO_FM('456.7')
      CALL FM_IGM1(M_A,M_B,M_C)
      M_D = TO_FM('3.9191215305400046110416169991395759293572844563673750M+21')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1400
      M_A = TO_FM('1.2')
      M_B = TO_FM('0')
      CALL FM_IGM1(M_A,M_B,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1401
      M_A = TO_FM('-1234.5')
      M_B = TO_FM('3.4')
      CALL FM_IGM1(M_A,M_B,M_C)
      M_D = TO_FM('-2.089243913181003055673082477964338279776719826973623M-661')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1402
      M_A = TO_FM('10.3')
      M_B = TO_FM('230.7')
      CALL FM_IGM1(M_A,M_B,M_C)
      M_D = TO_FM('7.1643068906237524454762965471616445342244699109269471M+5')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1403
      M_A = TO_FM('1.2')
      M_B = TO_FM('2.3')
      M_C = INCOMPLETE_GAMMA1(M_A,M_B)
      M_D = TO_FM('7.9163089830797686672658085698101181778608009481363580M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1404
      M_A = TO_FM('0')
      M_B = TO_FM('4.5')
      CALL FM_IGM2(M_A,M_B,M_C)
      M_D = TO_FM('2.0734007547146144328855938695797884889319725701443004M-3')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1405
      M_A = TO_FM('4.5')
      M_B = TO_FM('0')
      CALL FM_IGM2(M_A,M_B,M_C)
      M_D = TO_FM('1.1631728396567448929144224109426265262108918305803166M+1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1406
      M_A = TO_FM('1.2')
      M_B = TO_FM('2.3')
      CALL FM_IGM2(M_A,M_B,M_C)
      M_D = TO_FM('1.2653784409178374391437079820481858290074190484504480M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1407
      M_A = TO_FM('3.4')
      M_B = TO_FM('456.7')
      CALL FM_IGM2(M_A,M_B,M_C)
      M_D = TO_FM('1.1043526800164195407100289367720949121507981651704628M-192')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1408
      M_A = TO_FM('1.0E-30')
      M_B = TO_FM('40.7')
      CALL FM_IGM2(M_A,M_B,M_C)
      M_D = TO_FM('5.0619447546123889551107110735110897294460083487536391M-20')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1409
      M_A = TO_FM('-8000.3')
      M_B = TO_FM('1.0e-10')
      CALL FM_IGM2(M_A,M_B,M_C)
      M_D = TO_FM('1.24995312663273564605221746530224928996650914518900M+79999')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1410
      M_A = TO_FM('1')
      M_B = TO_FM('-10.7')
      CALL FM_IGM2(M_A,M_B,M_C)
      M_D = TO_FM('4.4355855130297866938628363428602120081387560278336788M+4')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1411
      M_A = TO_FM('1.2')
      M_B = TO_FM('2.3')
      M_C = INCOMPLETE_GAMMA2(M_A,M_B)
      M_D = TO_FM('1.2653784409178374391437079820481858290074190484504480M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1412
      M_A = TO_FM('0.1')
      M_B = TO_FM('23.4')
      M_C = TO_FM('34.5')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('5.8731980918960730463350151650813268739874201571164800M-27')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1413
      M_A = TO_FM('8.115640517330775M-1')
      M_B = TO_FM('2.00853601446773')
      M_C = TO_FM('1.59735792202923')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.0112520048150164306467955877563719782378767062440103M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1414
      M_A = TO_FM('9.01737835258975M-1')
      M_B = TO_FM('2.00853601446773')
      M_C = TO_FM('1.59735792202923')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.2512248738228585976753517954889151150428002974819213M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1415
      M_A = TO_FM('9.6097615596216720E-01')
      M_B = TO_FM('1.970425178583792')
      M_C = TO_FM('5.5680052333367')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.8619456987740165364092968281459448023932520843535423M-2')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1416
      M_A = TO_FM('4.764360371097952E-01')
      M_B = TO_FM('1.161514683661584E+01')
      M_C = TO_FM('2.937801562768354E-01')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.3604503996731113868791517339909092506365724801689105M-5')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1417
      M_A = TO_FM('0.9')
      M_B = TO_FM('23.4')
      M_C = TO_FM('34.5')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('7.3148127865937299821246829407023943740949130742928268M-18')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1418
      M_A = TO_FM('9.99496253868099M-1')
      M_B = TO_FM('2.47067979368109M+6')
      M_C = TO_FM('6.09475681774953M-100')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('1.7681753021411259894614747665450637683755190050365931M-544')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1419
      M_A = TO_FM('6.213433771653724M-1')
      M_B = TO_FM('8.854622686031200M-1')
      M_C = TO_FM('5.00000854049816M-121')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('1.1281271573737080091147788530326864610276172049831497M+0')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1420
      M_A = TO_FM('5.304391676698501M-15')
      M_B = TO_FM('4.870186358377400M+2')
      M_C = TO_FM('4.999955247889730M-98')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('8.789231448295684789660412810680366252747943306875046M-6956')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1421
      M_A = TO_FM('1.882803169800314M-7')
      M_B = TO_FM('1.591547060066600M-169')
      M_C = TO_FM('3.521822614438970M+6')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('6.2831946669434576663925763649227277100409122269443137M+168')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1422
      M_A = TO_FM('.9999999999999')
      M_B = TO_FM('8.591098092677430M+2')
      M_C = TO_FM('1.863210949748253M+1')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('3.9062929191651064065641350979581425238442928803700306M-40')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1423
      M_A = TO_FM('2.531772074701081M-99')
      M_B = TO_FM('3.547571261801072M+2')
      M_C = TO_FM('1.974896958876250M+6')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('4.09572371031661966931910120566898398359503771147050M-34981')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1424
      M_A = TO_FM('.99999999999999')
      M_B = TO_FM('1.0E-123')
      M_C = TO_FM('1.0E-134')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('1.0M+123')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1425
      M_A = TO_FM('1')
      M_B = TO_FM('2.65')
      M_C = TO_FM('4.88')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('1.5020204575152306127604878970920601604169827852591720M-2')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1426
      M_A = TO_FM('0')
      M_B = TO_FM('2.65')
      M_C = TO_FM('4.88')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('0')
      M_D = ABS(M_C - M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1427
      M_A = TO_FM('.998')
      M_B = TO_FM('759.6')
      M_C = TO_FM('4.95e-57')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('9.7133692099062434492386763673434080317019087637060970M-2')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1428
      M_A = TO_FM('4.764360371097952E-01')
      M_B = TO_FM('1.161514683661584E+01')
      M_C = TO_FM('2.937801562768354E-01')
      M_C = INCOMPLETE_BETA(M_A,M_B,M_C)
      M_D = TO_FM('2.3604503996731113868791517339909092506365724801689105M-5')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      RETURN
      END SUBROUTINE TEST45

      SUBROUTINE TEST46

!  Test the Polygamma, Psi functions.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing Polygamma, Psi.')")

      NCASE = 1429
      M_A = TO_FM('4.5')
      CALL FM_PGAM(0,M_A,M_C)
      M_D = TO_FM('1.3888709263595289015114046193821968137592213477205183M+0')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1430
      M_A = TO_FM('1.0E-123')
      CALL FM_PGAM(1,M_A,M_C)
      M_D = TO_FM('1.0M+246')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1431
      M_A = TO_FM('1.0E-123')
      CALL FM_PGAM(2,M_A,M_C)
      M_D = TO_FM('-2.0M+369')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1432
      M_A = TO_FM('2.0706137739520290320140007735608464643737932737070189M-1')
      CALL FM_PGAM(1,M_A,M_C)
      M_D = TO_FM('2.4580954480899934124966756607870377560864828849100481M+1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1433
      M_A = TO_FM('2.0706137739520290320140007735608464643737932737070189M-1')
      CALL FM_PGAM(6,M_A,M_C)
      M_D = TO_FM('-4.4120531379423056741117517146346730469682094212273241M+7')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1434
      M_A = TO_FM('2.0706137739520290320140007735608464643737932737070189M-1')
      CALL FM_PGAM(23,M_A,M_C)
      M_D = TO_FM('6.7006365293376930742991440911935017694098601683947073M+38')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1435
      M_A = TO_FM('1.0E+123')
      CALL FM_PGAM(4,M_A,M_C)
      M_D = TO_FM('-6.0M-492')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1436
      M_A = TO_FM('-6.499999840238790109')
      CALL FM_PGAM(4,M_A,M_C)
      M_D = TO_FM('1.0135142464863270830609416082237513111216512170936928M-16')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1437
      M_C = POLYGAMMA(2,TO_FM('1.0E-123'))
      M_D = TO_FM('-2.0M+369')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1438
      M_A = TO_FM('1.0E-135')
      CALL FM_PSI(M_A,M_C)
      M_D = TO_FM('-1.0M+135')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PSI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1439
      M_A = TO_FM('1.2')
      CALL FM_PSI(M_A,M_C)
      M_D = TO_FM('-2.8903989659218829554720796244995210482558827420664281M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PSI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1440
      M_A = TO_FM('-3.4')
      CALL FM_PSI(M_A,M_C)
      M_D = TO_FM('2.3844508141180140670320531380285019520468887144980679M+0')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PSI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1441
      M_A = TO_FM('57')
      CALL FM_PSI(M_A,M_C)
      M_D = TO_FM('4.0342536898816977739559850955847848905386809772893269M+0')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PSI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1442
      M_A = TO_FM('1.0E+56')
      CALL FM_PSI(M_A,M_C)
      M_D = TO_FM('1.2894476520766655830500752146232439562566168336321129M+2')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PSI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1443
      M_A = TO_FM('1.0')
      CALL FM_PSI(M_A,M_C)
      M_D = TO_FM('-5.7721566490153286060651209008240243104215933593992360M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PSI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1444
      M_A = TO_FM('1.0E+23456')
      CALL FM_PSI(M_A,M_C)
      M_D = TO_FM('5.4009435941268335564326007561076446853491436517276499M+4')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PSI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1445
      M_A = TO_FM('1.46163214496836234126266')
      CALL FM_PSI(M_A,M_C)
      M_D = TO_FM('4.4287869692570149446165609601581442013784186419176534M-25')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PSI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1446
      M_C = PSI(TO_FM('1.2'))
      M_D = TO_FM('-2.8903989659218829554720796244995210482558827420664281M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' PSI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1447
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = PSI(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == PSI(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 1448
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = PSI(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == PSI(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      RETURN
      END SUBROUTINE TEST46

      SUBROUTINE TEST47

!  Test the different rounding modes.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing the different rounding modes.')")

      CALL FMSETVAR(' MBASE = 10 ')
      CALL FMSETVAR(' NDIG = 20 ')
      M_A = 0

      NCASE = 1449
      CALL FMSETVAR(' KROUND = 1 ')
      M_C = TO_FM('2')/TO_FM('3')
      M_D = TO_FM('.66666666666666666667')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1450
      CALL FMSETVAR(' KROUND = -1 ')
      M_C = TO_FM('2')/TO_FM('3')
      M_D = TO_FM('.66666666666666666666')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1451
      CALL FMSETVAR(' KROUND = 0 ')
      M_C = TO_FM('2')/TO_FM('3')
      M_D = TO_FM('.66666666666666666666')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1452
      CALL FMSETVAR(' KROUND = 2 ')
      M_C = TO_FM('2')/TO_FM('3')
      M_D = TO_FM('.66666666666666666667')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1453
      CALL FMSETVAR(' KROUND = 1 ')
      M_C = TO_FM('1')/TO_FM('3')
      M_D = TO_FM('.33333333333333333333')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1454
      CALL FMSETVAR(' KROUND = -1 ')
      M_C = TO_FM('1')/TO_FM('3')
      M_D = TO_FM('.33333333333333333333')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1455
      CALL FMSETVAR(' KROUND = 0 ')
      M_C = TO_FM('1')/TO_FM('3')
      M_D = TO_FM('.33333333333333333333')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1456
      CALL FMSETVAR(' KROUND = 2 ')
      M_C = TO_FM('1')/TO_FM('3')
      M_D = TO_FM('.33333333333333333334')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1457
      CALL FMSETVAR(' KROUND = 1 ')
      M_C = TO_FM('-1')/TO_FM('3')
      M_D = TO_FM('-.33333333333333333333')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1458
      CALL FMSETVAR(' KROUND = -1 ')
      M_C = TO_FM('-1')/TO_FM('3')
      M_D = TO_FM('-.33333333333333333334')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1459
      CALL FMSETVAR(' KROUND = 0 ')
      M_C = TO_FM('-1')/TO_FM('3')
      M_D = TO_FM('-.33333333333333333333')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1460
      CALL FMSETVAR(' KROUND = 2 ')
      M_C = TO_FM('-1')/TO_FM('3')
      M_D = TO_FM('-.33333333333333333333')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1461
      CALL FMSETVAR(' KROUND = 1 ')
      M_C = TO_FM('-2')/TO_FM('3')
      M_D = TO_FM('-.66666666666666666667')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1462
      CALL FMSETVAR(' KROUND = -1 ')
      M_C = TO_FM('-2')/TO_FM('3')
      M_D = TO_FM('-.66666666666666666667')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1463
      CALL FMSETVAR(' KROUND = 0 ')
      M_C = TO_FM('-2')/TO_FM('3')
      M_D = TO_FM('-.66666666666666666666')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1464
      CALL FMSETVAR(' KROUND = 2 ')
      M_C = TO_FM('-2')/TO_FM('3')
      M_D = TO_FM('-.66666666666666666666')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1465
      CALL FMSETVAR(' KROUND = 1 ')
      M_C = TO_FM('1') + TO_FM('3E-555')
      M_D = TO_FM('1.0000000000000000000')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1466
      CALL FMSETVAR(' KROUND = -1 ')
      M_C = TO_FM('1') + TO_FM('3E-555')
      M_D = TO_FM('1.0000000000000000000')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1467
      CALL FMSETVAR(' KROUND = 0 ')
      M_C = TO_FM('1') + TO_FM('3E-555')
      M_D = TO_FM('1.0000000000000000000')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1468
      CALL FMSETVAR(' KROUND = 2 ')
      M_C = TO_FM('1') + TO_FM('3E-555')
      M_D = TO_FM('1.0000000000000000001')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1469
      CALL FMSETVAR(' KROUND = 1 ')
      M_C = TO_FM('1') - TO_FM('3E-555')
      M_D = TO_FM('1.0000000000000000000')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1470
      CALL FMSETVAR(' KROUND = -1 ')
      M_C = TO_FM('1') - TO_FM('3E-555')
      M_D = TO_FM('.99999999999999999999')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1471
      CALL FMSETVAR(' KROUND = 0 ')
      M_C = TO_FM('1') - TO_FM('3E-555')
      M_D = TO_FM('.99999999999999999999')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1472
      CALL FMSETVAR(' KROUND = 2 ')
      M_C = TO_FM('1') - TO_FM('3E-555')
      M_D = TO_FM('1.0000000000000000000')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1473
      CALL FMSETVAR(' KROUND = 1 ')
      M_C = TO_FM('-1') + TO_FM('3E-555')
      M_D = TO_FM('-1.0000000000000000000')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1474
      CALL FMSETVAR(' KROUND = -1 ')
      M_C = TO_FM('-1') + TO_FM('3E-555')
      M_D = TO_FM('-1.0000000000000000000')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1475
      CALL FMSETVAR(' KROUND = 0 ')
      M_C = TO_FM('-1') + TO_FM('3E-555')
      M_D = TO_FM('-.99999999999999999999')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1476
      CALL FMSETVAR(' KROUND = 2 ')
      M_C = TO_FM('-1') + TO_FM('3E-555')
      M_D = TO_FM('-.99999999999999999999')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1477
      CALL FMSETVAR(' KROUND = 1 ')
      M_C = TO_FM('-1') - TO_FM('3E-555')
      M_D = TO_FM('-1.0000000000000000000')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1478
      CALL FMSETVAR(' KROUND = -1 ')
      M_C = TO_FM('-1') - TO_FM('3E-555')
      M_D = TO_FM('-1.0000000000000000001')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1479
      CALL FMSETVAR(' KROUND = 0 ')
      M_C = TO_FM('-1') - TO_FM('3E-555')
      M_D = TO_FM('-1.0000000000000000000')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1480
      CALL FMSETVAR(' KROUND = 2 ')
      M_C = TO_FM('-1') - TO_FM('3E-555')
      M_D = TO_FM('-1.0000000000000000000')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' MBASE = 2 ')
      CALL FMSETVAR(' NDIG = 53 ')
      CALL FMSETVAR(' KROUND = 1 ')
      NCASE = 1481
      M_A = TO_FM('0.125')
      M_B = TO_FM('23.25')
      M_C = TO_FM('34.5')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('6.1345805065305141873M-25')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1482
      M_A = TO_FM('0.52')
      M_B = TO_FM('2.01')
      M_C = TO_FM('1.6')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('1.0304844627978347604M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1483
      M_A = TO_FM('9.01737835258975M-1')
      M_B = TO_FM('2.00853601446773')
      M_C = TO_FM('1.59735792202923')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.2512248738228585986M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1484
      M_A = TO_FM('9.6097615596216720E-01')
      M_B = TO_FM('1.970425178583792')
      M_C = TO_FM('5.5680052333367')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.8619456987740165927M-2')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1485
      M_A = TO_FM('4.764360371097952E-01')
      M_B = TO_FM('1.161514683661584E+01')
      M_C = TO_FM('2.937801562768354E-01')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.3604503996731113869M-5')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1486
      M_A = TO_FM('0.9')
      M_B = TO_FM('23.4')
      M_C = TO_FM('34.5')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('7.3148127865937395334M-18')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL FMSETVAR(' MBASE = 3 ')
      CALL FMSETVAR(' NDIG = 55 ')
      NCASE = 1487
      M_A = TO_FM('0.1')
      M_B = TO_FM('23.4')
      M_C = TO_FM('34.5')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('5.87319809189607304633501593392681M-27')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1488
      M_A = TO_FM('0.52')
      M_B = TO_FM('2.1')
      M_C = TO_FM('1.6')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('9.25745341552810210762563659429375M-2')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1489
      M_A = TO_FM('9.01737835258975M-1')
      M_B = TO_FM('2.00853601446773')
      M_C = TO_FM('1.59735792202923')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.25122487382285859767535178829535M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1490
      M_A = TO_FM('9.6097615596216720E-01')
      M_B = TO_FM('1.970425178583792')
      M_C = TO_FM('5.5680052333367')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.861945698774016536409296855493M-2')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1491
      M_A = TO_FM('4.764360371097952E-01')
      M_B = TO_FM('1.161514683661584E+01')
      M_C = TO_FM('2.937801562768354E-01')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.36045039967311138687915158221269M-5')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1492
      M_A = TO_FM('0.9')
      M_B = TO_FM('23.4')
      M_C = TO_FM('34.5')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('7.31481278659372998212468429642039M-18')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1493
      CALL FPST2M('1.67',MP1)
      CALL FPST2M('2.64',MP2)
      CALL FPADD(MP1,MP2,MP3)
      CALL FPEQ(MP3,MP1)
      CALL FPST2M('-3.91',MP2)
      CALL FPSUB(MP1,MP2,MP3)
      CALL FPEQ(MP3,MP1)
      CALL FPST2M('4.58',MP2)
      CALL FPMPY(MP1,MP2,MP3)
      CALL FPEQ(MP3,MP1)
      CALL FPST2M('0.27',MP2)
      CALL FPDIV(MP1,MP2,MP3)
      CALL FPEQ(MP3,MP1)
      CALL FPADDI(MP1,2)
      CALL FPMPYI(MP1,13,MP3)
      CALL FPEQ(MP3,MP1)
      CALL FPDIVI(MP1,11,MP3)
      CALL FPEQ(MP3,MP1)
      CALL FPLN(MP1,MP3)
      CALL FPEQ(MP3,MP1)
      CALL FPSIN(MP1,MP3)
      CALL FPEQ(MP3,MP1)
      CALL FPCOS(MP1,MP3)
      CALL FPEQ(MP3,MP1)
      CALL FPEXP(MP1,MP3)
      CALL FPEQ(MP3,MP1)
      CALL FPGAM(MP1,MP3)
      CALL FPEQ(MP3,MP1)
      CALL FMUNPK(MP1,M3FM)
      CALL FMEQ(M3FM,M_C%MFM)
      M_D = TO_FM('0.941122001974472326543759839200398')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
          CALL ERRPRT_FM(' Pack ',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1494
      CALL FM_RANDOM_SEED_SIZE(J)
      SEED = (/ 2718281,8284590,4523536,0287471,3526624,9775724,7093699 /)
      CALL FM_RANDOM_SEED_PUT(SEED)
      DO J1 = 1, 10
         CALL FM_RANDOM_NUMBER(D1)
      ENDDO
      CALL FM_RANDOM_SEED_GET(SEED)
      M_C = D1
      M_D = TO_FM('0.931628836663817')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-10')) .OR. .NOT.(J == 7)) THEN
          CALL ERRPRT_FM(' Rand ',M_C,'M_C',M_C,'M_C',M_D,'M_D')
      ENDIF

      RETURN
      END SUBROUTINE TEST47

      SUBROUTINE TEST48

!  Test cases close to 1/2 ulp rounding error, so a retry is required for perfect rounding.
!  Some cases are also included for results close to a representable number, to check perfect
!  rounding in the other three rounding modes:  toward -infinity, toward zero, toward +infinity.

      IMPLICIT NONE

      CALL FMSETVAR(' MBASE = 10000 ')
      CALL FMSETVAR(' NDIG = 10 ')
      CALL FMSETVAR(' KROUND = 1 ')

      NCASE = 1495
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('5.000000000000000000000000000000000000001e-41')
      M_C = M_A + M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768402')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1496
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('4.999999999999999999999999999999999999999e-41')
      M_C = M_A + M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768401')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1497
      M_A = TO_FM('5.000000000000000000000000000000000000001e-37')
      M_C = M_A
      CALL FM_ADDI(M_C,2)
      M_D = TO_FM('2.000000000000000000000000000000000001')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1498
      M_C = TO_FM('4.999999999999999999999999999999999999999e-37')
      CALL FM_ADDI(M_C,2)
      M_D = TO_FM('2.000000000000000000000000000000000000000')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1499
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('5.000000000000000000000000000000000000001e-41')
      M_C = M_A - M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768400')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1500
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('4.999999999999999999999999999999999999999e-41')
      M_C = M_A - M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768401')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1501
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('0.5257635728213180166595247703159528791601')
      M_C = M_A * M_B
      M_D = TO_FM('0.3303469955801149926388139215009285936894')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1502
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('0.4742364271786819833404752296840471208399')
      M_C = M_A * M_B
      M_D = TO_FM('0.2979715351378436550537147551549719831507')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1503
      M_A = TO_FM('0.6318370867781348553996520736856019490561')
      CALL FM_MPYI(M_A,46101123,M_C)
      M_D = TO_FM('29128399.25352046867936657440618499878248')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1504
      M_A = TO_FM('0.8135122987796887463349472568784450350361')
      CALL FM_MPYI(M_A,20316759,M_C)
      M_D = TO_FM('16527933.31784293035429925669571046007157')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1505
      M_A = TO_FM('0.6318370867781348553996520736856019490561')
      CALL FM_MPYI_R1(M_A,46101123)
      M_C = M_A
      M_D = TO_FM('29128399.25352046867936657440618499878248')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1506
      M_A = TO_FM('0.8135122987796887463349472568784450350361')
      CALL FM_MPYI_R1(M_A,20316759)
      M_C = M_A
      M_D = TO_FM('16527933.31784293035429925669571046007157')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1507
      M_A = TO_FM('0.3976743471825143687216599350592794108215')
      M_B = TO_FM('0.9424777960769379715387930149838508652591')
      M_C = M_A / M_B
      M_D = TO_FM('0.4219455872995980174105705502942218606745')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1508
      M_A = TO_FM('0.6919325506063328369126062247898634980537')
      M_B = TO_FM('0.9424777960769379715387930149838508652591')
      M_C = M_A / M_B
      M_D = TO_FM('0.7341632381012059477682883491173344179766')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1509
      M_A = TO_FM('36461617.89732034137767779122871087621687')
      CALL FM_DIVI(M_A,63388493,M_C)
      M_D = TO_FM('.5752087827252864550302180433396780109108')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1510
      M_A = TO_FM('37124279.59189018208711544238998994234663')
      CALL FM_DIVI(M_A,75134789,M_C)
      M_D = TO_FM('.4941024003127257346409190340574449786054')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1511
      M_A = TO_FM('36461617.89732034137767779122871087621687')
      CALL FM_DIVI_R1(M_A,63388493)
      M_C = M_A
      M_D = TO_FM('.5752087827252864550302180433396780109108')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1512
      M_A = TO_FM('37124279.59189018208711544238998994234663')
      CALL FM_DIVI_R1(M_A,75134789)
      M_C = M_A
      M_D = TO_FM('.4941024003127257346409190340574449786054')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1513
      M_A = TO_FM('0.9999999999999999999999999999999999999999')
      M_C = SQRT(M_A)
      M_D = TO_FM('0.9999999999999999999999999999999999999999')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1514
      M_A = TO_FM('0.0812551668996974871345739579795687707841')
      M_C = SQRT(M_A)
      M_D = TO_FM('0.2850529194723279573072539887330984043228')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1515
      M_A = TO_FM('0.5985846996875529104874722961539082031432e-36')
      M_C = ACOS(M_A)
      M_D = TO_FM('1.570796326794896619231321691639751441')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1516
      M_A = TO_FM('0.5985846996875529104874722961539082031430e-36')
      M_C = ACOS(M_A)
      M_D = TO_FM('1.570796326794896619231321691639751442')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1517
      M_A = TO_FM('3.1072325059538588668776624275223863628e-19')
      M_C = ASIN(M_A)
      M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1518
      M_A = TO_FM('3.1072325059538588668776624275223863629e-19')
      M_C = ASIN(M_A)
      M_D = TO_FM('3.1072325059538588668776624275223863630e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1519
      M_A = TO_FM('2.4662120743304701014916113231545890428e-19')
      M_C = ATAN(M_A)
      M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1520
      M_A = TO_FM('2.4662120743304701014916113231545890427e-19')
      M_C = ATAN(M_A)
      M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1521
      M_A = TO_FM('24.662120743304701014916113231545890428')
      M_B = TO_FM('1M+20')
      M_C = ATAN(M_A,M_B)
      M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1522
      M_A = TO_FM('24.662120743304701014916113231545890427')
      M_B = TO_FM('1M+20')
      CALL FM_ATAN2(M_A,M_B,M_C)
      M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1523
      M_A = TO_FM('24.662120743304701014916113231545890428')
      M_B = TO_FM('19.598731519274866200933093993663363141')
      M_C = HYPOT(M_A,M_B)
      M_D = TO_FM('31.5012773823849581936652001656744299068083994252835506543708')
      IF (.NOT.(ABS(M_C-M_D) < TO_FM('1.0e-48'))) THEN
          CALL ERRPRT_FM('HYPOT ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1524
      M_A = TO_FM('24.662120743304701014916113231545890428')
      M_B = TO_FM('19.598731519274866200933093993663363141')
      CALL FM_HYPOT(M_A,M_B,M_C)
      M_D = TO_FM('31.5012773823849581936652001656744299068083994252835506543708')
      IF (.NOT.(ABS(M_C-M_D) < TO_FM('1.0e-48'))) THEN
          CALL ERRPRT_FM('HYPOT ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1525
      MFMV1 = (/ TO_FM('24.662120743304701014916113231545890428') ,  &
                 TO_FM('19.598731519274866200933093993663363141') ,  &
                 TO_FM('23.520738351029238695449251124646311397') /)
      M_C = NORM2(MFMV1)
      M_D = TO_FM('39.3135550325779588382790713936439732249056062358880803608351')
      IF (.NOT.(ABS(M_C-M_D) < TO_FM('1.0e-48'))) THEN
          CALL ERRPRT_FM('NORM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1526
      M_A = TO_FM('3.1072325059538588668776624275223863629e-19')
      M_C = SIN(M_A)
      M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1527
      M_A = TO_FM('3.1072325059538588668776624275223863628e-19')
      M_C = SIN(M_A)
      M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1528
      M_A = TO_FM('1.0e-20')
      M_C = COS(M_A)
      M_D = TO_FM('1.0')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1529
      M_A = TO_FM('1.000000000000000000000000000000000001e-20')
      M_C = COS(M_A)
      M_D = TO_FM('0.9999999999999999999999999999999999999999')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1530
      M_A = TO_FM('3.1072325059538588668776624275223863629e-19')
      CALL FM_CSSN(M_A,M_B,M_C)
      M_D = TO_FM('.9999999999999999999999999999999999999517')
      IF (.NOT.(M_D == M_B)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
      ENDIF
      M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1531
      M_A = TO_FM('3.1072325059538588668776624275223863628e-19')
      CALL FM_CSSN(M_A,M_B,M_C)
      M_D = TO_FM('.9999999999999999999999999999999999999517')
      IF (.NOT.(M_D == M_B)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
      ENDIF
      M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1532
      M_A = TO_FM('1.0e-20')
      CALL FM_CSSN(M_A,M_B,M_C)
      M_D = TO_FM('1.0')
      IF (.NOT.(M_D == M_B)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
      ENDIF
      M_D = TO_FM('1.0e-20')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1533
      M_A = TO_FM('1.000000000000000000000000000000000001e-20')
      CALL FM_CSSN(M_A,M_B,M_C)
      M_D = TO_FM('0.9999999999999999999999999999999999999999')
      IF (.NOT.(M_D == M_B)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
      ENDIF
      M_D = TO_FM('1.000000000000000000000000000000000001e-20')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1534
      M_A = TO_FM('3.1072325059538588668776624275223863629e-19')
      M_C = SINH(M_A)
      M_D = TO_FM('3.1072325059538588668776624275223863630e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1535
      M_A = TO_FM('3.1072325059538588668776624275223863628e-19')
      M_C = SINH(M_A)
      M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1536
      M_A = TO_FM('1.0e-18')
      M_C = COSH(M_A)
      M_D = TO_FM('1.000000000000000000000000000000000001')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1537
      M_A = TO_FM('9.9999999999999999999999999999999999988e-19')
      M_C = COSH(M_A)
      M_D = TO_FM('1.0')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1538
      M_A = TO_FM('3.1072325059538588668776624275223863629e-19')
      CALL FM_CHSH(M_A,M_B,M_C)
      M_D = TO_FM('1.0')
      IF (.NOT.(M_D == M_B)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
      ENDIF
      M_D = TO_FM('3.1072325059538588668776624275223863630e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1539
      M_A = TO_FM('3.1072325059538588668776624275223863628e-19')
      CALL FM_CHSH(M_A,M_B,M_C)
      M_D = TO_FM('1.0')
      IF (.NOT.(M_D == M_B)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
      ENDIF
      M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1540
      M_A = TO_FM('1.0e-18')
      CALL FM_CHSH(M_A,M_B,M_C)
      M_D = TO_FM('1.000000000000000000000000000000000001')
      IF (.NOT.(M_D == M_B)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
      ENDIF
      M_D = TO_FM('1.00000000000000000000000000000000000017e-18')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1541
      M_A = TO_FM('9.9999999999999999999999999999999999988e-19')
      CALL FM_CHSH(M_A,M_B,M_C)
      M_D = TO_FM('1.0')
      IF (.NOT.(M_D == M_B)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
      ENDIF
      M_D = TO_FM('1.00000000000000000000000000000000000005e-18')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1542
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('5.000000000000000000000000000000000000001e-41')
      M_C = DIM(M_A,M_B)
      M_D = TO_FM('0.6283185307179586476925286766559005768400')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1543
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('4.999999999999999999999999999999999999999e-41')
      M_C = DIM(M_A,M_B)
      M_D = TO_FM('0.6283185307179586476925286766559005768401')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1544
      M_A = TO_FM('0.5e-36')
      M_C = EXP(M_A)
      M_D = TO_FM('1.000000000000000000000000000000000001')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1545
      M_A = TO_FM('0.4999999999999999999999999999999999989999e-36')
      M_C = EXP(M_A)
      M_D = TO_FM('1.0')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1546
      M_A = TO_FM('1.0000000000000000000000000000000000005000000000000000000000000000000000001')
      M_C = M_A
      M_D = TO_FM('1.000000000000000000000000000000000001')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1547
      M_A = TO_FM('1.000000000000000000000000000000000000499999999999999999999999999999999999999')
      M_C = M_A
      M_D = TO_FM('1.0')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1548
      M_A = TO_FM('1.000000000000000000707106781186547524')
      M_C = M_A ** 2
      M_D = TO_FM('1.000000000000000001414213562373095048')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1549
      M_A = TO_FM('1.000000000000000000707106781186547525')
      M_C = M_A ** 2
      M_D = TO_FM('1.000000000000000001414213562373095051')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1550
      M_A = TO_FM('1.000000000000000000707106781186547524')
      CALL FM_SQR(M_A,M_C)
      M_D = TO_FM('1.000000000000000001414213562373095048')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1551
      M_A = TO_FM('1.000000000000000000707106781186547525')
      CALL FM_SQR(M_A,M_C)
      M_D = TO_FM('1.000000000000000001414213562373095051')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1552
      M_A = TO_FM('0.9999999999999999994067407863053487817742')
      M_C = LOG(M_A)
      M_D = TO_FM('-5.9325921369465121840177824731679791984e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1553
      M_A = TO_FM('0.9999999999999999993793990486547925547640')
      M_C = LOG(M_A)
      M_D = TO_FM('-6.2060095134520744542857277040528826945e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1554
      M_A = TO_FM('1.000000000000000000958662527832292178')
      M_C = LOG10(M_A)
      M_D = TO_FM('4.1634184584498706665047310953955053593e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1555
      M_A = TO_FM('0.9999999999999999994778241676797874940004')
      M_C = LOG10(M_A)
      M_D = TO_FM('-2.2677808255990599106049606546937597102e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1556
      CALL FM_LNI(2895833,M_C)
      M_D = TO_FM('14.878783365079154638251408713480965444')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1557
      CALL FM_LNI(2531896,M_C)
      M_D = TO_FM('14.744478987153028713006171333463425116')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1558
      M_A = TO_FM('.8830071479276119336989609534710013727931')
      M_B = TO_FM('.2983029918655860363206006071417293306070')
      M_C = M_A ** M_B
      M_D = TO_FM('.9635648854663441602276295143804091214980')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1559
      M_A = TO_FM('.2046822834634936204259667947178397091054')
      M_B = TO_FM('.0113741193573152263874178352602582175058')
      M_C = M_A ** M_B
      M_D = TO_FM('.9821190715107246840300334336752116983076')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1560
      M_A = TO_FM('.7668605659739208337937419810211254654597')
      CALL FM_RATIONAL_POWER(M_A,3,7,M_C)
      M_D = TO_FM('.8924681893919363302730585208912593273843')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1561
      M_A = TO_FM('.9062372571831410794348152141805768025855')
      CALL FM_RATIONAL_POWER(M_A,3,7,M_C)
      M_D = TO_FM('.9586831750229133225694901565227212287703')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1562
      M_A = TO_FM('2.4662120743304701014916113231545890428e-19')
      M_C = TAN(M_A)
      M_D = TO_FM('2.4662120743304701014916113231545890429e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1563
      M_A = TO_FM('2.4662120743304701014916113231545890427e-19')
      M_C = TAN(M_A)
      M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1564
      M_A = TO_FM('2.4662120743304701014916113231545890428e-19')
      M_C = TANH(M_A)
      M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1565
      M_A = TO_FM('2.4662120743304701014916113231545890427e-19')
      M_C = TANH(M_A)
      M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1566
      M_X = TO_ZM('0.6283185307179586476925286766559005768401     + 2 i')
      M_Y = TO_ZM('5.000000000000000000000000000000000000001e-41  + 3 i')
      M_Y = M_X + M_Y
      M_Z = TO_ZM('0.6283185307179586476925286766559005768402     + 5 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1567
      M_X = TO_ZM(' 2 + 0.6283185307179586476925286766559005768401 i ')
      M_Y = TO_ZM(' 3 + 4.999999999999999999999999999999999999999e-41 i ')
      M_Y = M_X + M_Y
      M_Z = TO_ZM(' 5 + 0.6283185307179586476925286766559005768401 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1568
      M_X = TO_ZM(' 0.6283185307179586476925286766559005768401    + '//  &
                  ' 5.000000000000000000000000000000000000001e-41 i ')
      M_Y = TO_ZM(' 4.999999999999999999999999999999999999999e-41 + '//  &
                  ' 0.6283185307179586476925286766559005768401 i ')
      M_Y = M_X + M_Y
      M_Z = TO_ZM(' 0.6283185307179586476925286766559005768401 + '//  &
                  ' 0.6283185307179586476925286766559005768402 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF
      NCASE = 1569
      M_X = TO_ZM('0.6283185307179586476925286766559005768401     + 2 i')
      M_Y = TO_ZM('5.000000000000000000000000000000000000001e-41  - 3 i')
      M_Y = M_X - M_Y
      M_Z = TO_ZM('0.6283185307179586476925286766559005768400     + 5 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1570
      M_X = TO_ZM(' 2 + 0.6283185307179586476925286766559005768401 i ')
      M_Y = TO_ZM('-3 + 4.999999999999999999999999999999999999999e-41 i ')
      M_Y = M_X - M_Y
      M_Z = TO_ZM(' 5 + 0.6283185307179586476925286766559005768401 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1571
      M_X = TO_ZM(' 0.6283185307179586476925286766559005768401    + '//  &
                  ' 5.000000000000000000000000000000000000001e-41 i ')
      M_Y = TO_ZM(' 4.999999999999999999999999999999999999999e-41 + '//  &
                  ' 0.6283185307179586476925286766559005768401 i ')
      M_Y = M_X - M_Y
      M_Z = TO_ZM(' 0.6283185307179586476925286766559005768401 - '//  &
                  ' 0.6283185307179586476925286766559005768400 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1572
      M_X = TO_ZM(' 0.6283185307179586476925286766559005768401 + 2e-71 i ')
      M_Y = TO_ZM(' 0.5257635728213180166595247703159528791601 + 3e-72 i ')
      M_Y = M_X * M_Y
      M_Z = TO_ZM(' 0.3303469955801149926388139215009285936894 + '//  &
                  ' 1.2400227048580236276268081436286759314e-71 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1573
      M_X = TO_ZM(' 0.6283185307179586476925286766559005768401 + 2e-71 i ')
      M_Y = TO_ZM(' 3e-72 + 0.4742364271786819833404752296840471208399 i ')
      M_Y = M_X * M_Y
      M_Z = TO_ZM(' -7.599772951419763723731918563713240686e-72 + '//  &
                  ' 0.2979715351378436550537147551549719831507 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1574
      M_X = TO_ZM(' 0.6283185307179586476925286766559005768401 ')
      M_Y = TO_ZM(' 3e-72 + 0.4742364271786819833404752296840471208399 i ')
      M_Y = M_X * M_Y
      M_Z = TO_ZM(' 1.884955592153875943077586029967701731e-72 + '//  &
                  ' 0.2979715351378436550537147551549719831507 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1575
      M_X = TO_ZM(' 0.3976743471825143687216599350592794108215 + 2e-71 i ')
      M_Y = TO_ZM(' 0.9424777960769379715387930149838508652591 + 3e-72 i ')
      M_Y = M_X / M_Y
      M_Z = TO_ZM(' 0.4219455872995980174105705502942218606745 + '//  &
                  ' 1.9877564560228500546418079520211719271e-71 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1576
      M_X = TO_ZM(' 0.6919325506063328369126062247898634980537 + 2e-71 i ')
      M_Y = TO_ZM(' 3e-72 + 0.9424777960769379715387930149838508652591 i ')
      M_Y = M_X / M_Y
      M_Z = TO_ZM(' 2.3557573246522558864973918862865235752e-71 - '//  &
                  ' 0.7341632381012059477682883491173344179766 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1577
      M_X = TO_ZM(' 0.6919325506063328369126062247898634980537 + 2e-71 i ')
      M_Y = TO_ZM(' 0 + 0.9424777960769379715387930149838508652591 i ')
      M_Y = M_X / M_Y
      M_Z = TO_ZM(' 2.1220659078919378102517835116335248271e-71 - '//  &
                  ' 0.7341632381012059477682883491173344179766 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1578
      M_Y = TO_ZM('5.000000000000000000000000000000000000001e-37 + 4 i')
      CALL ZM_ADDI(M_Y,2)
      M_Z = TO_ZM('2.000000000000000000000000000000000001 + 4 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1579
      M_Y = TO_ZM('4.999999999999999999999999999999999999999e-37 + 6 i')
      CALL ZM_ADDI(M_Y,3)
      M_Z = TO_ZM('3 + 6 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1580
      M_X = TO_ZM('1 + e-18 i')
      M_C = ABS(M_X)
      M_D = TO_FM('1.0')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',TO_ZM(M_C),'M_C',TO_ZM(M_D),'M_D')
      ENDIF

      NCASE = 1581
      M_X = TO_ZM('1 + e-18 i') + TO_ZM(' e-52 i ')
      M_C = ABS(M_X)
      M_D = TO_FM('1.000000000000000000000000000000000001')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',TO_ZM(M_C),'M_C',TO_ZM(M_D),'M_D')
      ENDIF

      NCASE = 1582
      M_X = TO_ZM('0.5985846996875529104874722961539082031432e-36 + e-50 i')
      M_Y = ACOS(M_X)
      M_Z = TO_ZM('1.570796326794896619231321691639751441 - e-50')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1583
      M_X = TO_ZM('0.5985846996875529104874722961539082031430e-36 + e-50 i')
      M_Y = ACOS(M_X)
      M_Z = TO_ZM('1.570796326794896619231321691639751442 - e-50')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1584
      M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863628e-19 i')
      M_Y = ACOS(M_X)
      M_Z = TO_ZM('1.570796326794896619231321691639751442') -  &
            TO_ZM('3.1072325059538588668776624275223863628e-19 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1585
      M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863630e-19 i')
      M_Y = ACOS(M_X)
      M_Z = TO_ZM('1.570796326794896619231321691639751442') -  &
            TO_ZM('3.1072325059538588668776624275223863629e-19 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1586
      M_X = TO_ZM(' 1e+20 + 24.662120743304701014916113231545890428 i ')
      CALL ZM_ARG(M_X,M_C)
      M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1587
      M_X = TO_ZM(' 1e+20 + 24.662120743304701014916113231545890427 i ')
      CALL ZM_ARG(M_X,M_C)
      M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1588
      M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863628e-19 i')
      M_Y = ASIN(M_X)
      M_Z = TO_ZM('9.9999999999999999999999999999999999995e-51') +  &
            TO_ZM('3.1072325059538588668776624275223863628e-19 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1589
      M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863630e-19 i')
      M_Y = ASIN(M_X)
      M_Z = TO_ZM('9.9999999999999999999999999999999999995e-51') +  &
            TO_ZM('3.1072325059538588668776624275223863629e-19 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1590
      M_X = TO_ZM('2.4662120743304701014916113231545890428e-19 + e-50 i')
      M_Y = ATAN(M_X)
      M_Z = TO_ZM('2.4662120743304701014916113231545890427e-19') +  &
            TO_ZM('.99999999999999999999999999999999999994e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1591
      M_X = TO_ZM('2.4662120743304701014916113231545890427e-19 + e-50 i')
      M_Y = ATAN(M_X)
      M_Z = TO_ZM('2.4662120743304701014916113231545890427e-19') +  &
            TO_ZM('.99999999999999999999999999999999999994e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1592
      M_X = TO_ZM('3.1072325059538588668776624275223863629e-19 + e-50 i')
      M_Y = SINH(M_X)
      M_Z = TO_ZM('3.1072325059538588668776624275223863630e-19') +  &
            TO_ZM('1.00000000000000000000000000000000000005e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1593
      M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863629e-19 i')
      M_Y = SINH(M_X)
      M_Z = TO_ZM('9.9999999999999999999999999999999999995e-51') +  &
            TO_ZM('3.1072325059538588668776624275223863628e-19 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1594
      M_X = TO_ZM('1.0e-18 + e-50 i')
      M_Y = COSH(M_X)
      M_Z = TO_ZM('1.000000000000000000000000000000000001') +  &
            TO_ZM('1.0E-68 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1595
      M_X = TO_ZM('9.9999999999999999999999999999999999988e-19 + e-50 i')
      M_Y = COSH(M_X)
      M_Z = TO_ZM('1.0 + e-68 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1596
      M_Z = TO_ZM('9.9999999999999999999999999999999999988e-19 + e-50 i')
      CALL ZM_COSH_SINH(M_Z,M_X,M_Y)
      M_Z = TO_ZM('1.0 + e-68 i')
      IF (.NOT.(M_X == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF
      M_Z = TO_ZM('1.00000000000000000000000000000000000005e-18') +  &
            TO_ZM('1.0000000000000000000000000000000000005e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1597
      M_Z = TO_ZM('e-50 + 3.1072325059538588668776624275223863629e-19 i')
      CALL ZM_COSH_SINH(M_Z,M_X,M_Y)
      M_Z = TO_ZM('0.9999999999999999999999999999999999999517') +  &
            TO_ZM('3.10723250595385886687766242752238636285e-69 i')
      IF (.NOT.(M_X == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF
      M_Z = TO_ZM('9.9999999999999999999999999999999999995e-51') +  &
            TO_ZM('3.1072325059538588668776624275223863628e-19 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1598
      M_Z = TO_ZM('3.1072325059538588668776624275223863629e-19 + e-50 i')
      CALL ZM_COSH_SINH(M_Z,M_X,M_Y)
      M_Z = TO_ZM('1.0 + 3.10723250595385886687766242752238636295e-69 i')
      IF (.NOT.(M_X == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF
      M_Z = TO_ZM('3.1072325059538588668776624275223863630e-19') +  &
            TO_ZM('1.00000000000000000000000000000000000005e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1599
      M_X = TO_ZM('3.1072325059538588668776624275223863629e-19 + e-50 i')
      M_Y = SIN(M_X)
      M_Z = TO_ZM('3.1072325059538588668776624275223863628e-19') +  &
            TO_ZM('9.9999999999999999999999999999999999995e-51 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1600
      M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863629e-19 i')
      M_Y = SIN(M_X)
      M_Z = TO_ZM('1.00000000000000000000000000000000000005e-50') +  &
            TO_ZM('3.1072325059538588668776624275223863630e-19 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1601
      M_X = TO_ZM('1.0e-20 + e-50 i')
      M_Y = COS(M_X)
      M_Z = TO_ZM('1.0 - 1.0e-70 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1602
      M_X = TO_ZM('1.000000000000000000000000000000000001e-20 + e-50 i')
      M_Y = COS(M_X)
      M_Z = TO_ZM('0.9999999999999999999999999999999999999999') -  &
            TO_ZM('1.00000000000000000000000000000000000100e-70 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1603
      M_Z = TO_ZM('3.1072325059538588668776624275223863629e-19 + e-50 i')
      CALL ZM_COS_SIN(M_Z,M_X,M_Y)
      M_Z = TO_ZM('.9999999999999999999999999999999999999517') -  &
            TO_ZM('3.107232505953858866877662427522386362850e-69 i')
      IF (.NOT.(M_X == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF
      M_Z = TO_ZM('3.1072325059538588668776624275223863628e-19') +  &
            TO_ZM('9.9999999999999999999999999999999999995e-51 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1604
      M_Z = TO_ZM('e-50 + 3.1072325059538588668776624275223863629e-19 i')
      CALL ZM_COS_SIN(M_Z,M_X,M_Y)
      M_Z = TO_ZM('1.0 - 3.107232505953858866877662427522386362950e-69 i')
      IF (.NOT.(M_X == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF
      M_Z = TO_ZM('1.00000000000000000000000000000000000005e-50') +  &
            TO_ZM('3.1072325059538588668776624275223863630e-19 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1605
      M_Z = TO_ZM('3.1072325059538588668776624275223863629e-19 + e-50 i')
      CALL ZM_COS_SIN(M_Z,M_X,M_Y)
      M_Z = TO_ZM('9.999999999999999999999999999999999999517e-1') -  &
            TO_ZM('3.107232505953858866877662427522386362850e-69 i')
      IF (.NOT.(M_X == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF
      M_Z = TO_ZM('3.1072325059538588668776624275223863628e-19') +  &
            TO_ZM('9.9999999999999999999999999999999999995e-51 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1606
      M_X = TO_ZM('0.5e-36 + e-80 i')
      M_Y = EXP(M_X)
      M_Z = TO_ZM('1.000000000000000000000000000000000001') +  &
            TO_ZM('1.000000000000000000000000000000000001e-80 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1607
      M_X = TO_ZM('4.999999999999999999999999999999999989999e-37 + e-80 i')
      M_Y = EXP(M_X)
      M_Z = TO_ZM('1.0 + e-80 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1608
      M_X = TO_ZM('1.000000000000000000707106781186547524 + e-50 i')
      M_Y = M_X ** 2
      M_Z = TO_ZM('1.000000000000000001414213562373095048') +  &
            TO_ZM('2.000000000000000001414213562373095048e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1609
      M_X = TO_ZM('e-50 + 1.000000000000000000707106781186547525 i')
      M_Y = M_X ** 2
      M_Z = TO_ZM('-1.000000000000000001414213562373095051') +  &
            TO_ZM(' 2.000000000000000001414213562373095050e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1610
      M_X = TO_ZM('0.9999999999999999994778241676797874940004 + e-50 i')
      M_Y = LOG10(M_X)
      M_Z = TO_ZM('-2.2677808255990599106049606546937597102E-19') +  &
            TO_ZM(' 4.3429448190325182787790700147651107341e-51 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1611
      M_X = TO_ZM('.8455190010494953391255848876096865326839') +  &
            TO_ZM(' .7861461988847145319251164691167782914963 i')
      M_Y = LOG10(M_X)
      M_Z = TO_ZM('.0624033825129988962409024321757246973134') +  &
            TO_ZM('.3252980116488363982766948434519904605853 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1612
      M_X = TO_ZM('0.9999999999999999993793990486547925547640 + e-50 i')
      M_Y = LOG(M_X)
      M_Z = TO_ZM('-6.2060095134520744542857277040528826945e-19') +  &
            TO_ZM(' 1.00000000000000000062060095134520744562e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1613
      M_X = TO_ZM('1e+20 + 24.662120743304701014916113231545890428 i')
      M_Y = LOG(M_X)
      M_Z = TO_ZM('46.051701859880913680359829093687284152') +  &
            TO_ZM('2.4662120743304701014916113231545890427e-19 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1614
      M_X = TO_ZM('.8830071479276119336989609534710013727931 + e-50 i')
      M_Y = TO_ZM('.2983029918655860363206006071417293306070 - e-51 i')
      M_Y = M_X ** M_Y
      M_Z = TO_ZM('0.9635648854663441602276295143804091214980') +  &
            TO_ZM('3.3750637551181513929342847538584028563e-51 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1615
      M_X = TO_ZM('.2046822834634936204259667947178397091054 + e-50 i')
      M_Y = TO_ZM('.0113741193573152263874178352602582175058 - e-51 i')
      M_Y = M_X ** M_Y
      M_Z = TO_ZM('.9821190715107246840300334336752116983076') +  &
            TO_ZM('2.1036918503256548440548740118221763962e-51 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1616
      M_X = TO_ZM('.7668605659739208337937419810211254654597 + e-50 i')
      CALL ZM_RATIONAL_POWER(M_X,3,7,M_Y)
      M_Z = TO_ZM('0.8924681893919363302730585208912593273843') +  &
            TO_ZM('4.9876911638623221362078386375958597571e-51 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1617
      M_X = TO_ZM('.9062372571831410794348152141805768025855 + e-50 i')
      CALL ZM_RATIONAL_POWER(M_X,3,7,M_Y)
      M_Z = TO_ZM('.9586831750229133225694901565227212287703') +  &
            TO_ZM('4.533737877253610724793982869327765542e-51 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1618
      M_X = TO_ZM('1.000000000000000000707106781186547524 + e-50 i')
      CALL ZM_SQR(M_X,M_Y)
      M_Z = TO_ZM('1.000000000000000001414213562373095048') +  &
            TO_ZM('2.000000000000000001414213562373095048e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1619
      M_X = TO_ZM('1.000000000000000000707106781186547525 + e-50 i')
      CALL ZM_SQR(M_X,M_Y)
      M_Z = TO_ZM('1.000000000000000001414213562373095051') +  &
            TO_ZM('2.000000000000000001414213562373095050e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1620
      M_X = TO_ZM('0.9999999999999999999999999999999999999999 + e-50 i')
      CALL ZM_SQRT(M_X,M_Y)
      M_Z = TO_ZM('0.9999999999999999999999999999999999999999') +  &
            TO_ZM('5e-51 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1621
      M_X = TO_ZM('0.0812551668996974871345739579795687707841 + e-50 i')
      CALL ZM_SQRT(M_X,M_Y)
      M_Z = TO_ZM('0.2850529194723279573072539887330984043228') +  &
            TO_ZM('1.75406026686402147370502782695083137048e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1622
      M_X = TO_ZM('2.4662120743304701014916113231545890428e-19 + e-50 i')
      CALL ZM_TAN(M_X,M_Y)
      M_Z = TO_ZM('2.4662120743304701014916113231545890429e-19') +  &
            TO_ZM('1.00000000000000000000000000000000000006e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1623
      M_X = TO_ZM('2.4662120743304701014916113231545890427e-19 + e-50 i')
      CALL ZM_TAN(M_X,M_Y)
      M_Z = TO_ZM('2.4662120743304701014916113231545890427e-19') +  &
            TO_ZM('1.00000000000000000000000000000000000006e-50 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1624
      M_X = TO_ZM('2.4662120743304701014916113231545890428e-19 + e-50 i')
      CALL ZM_TANH(M_X,M_Y)
      M_Z = TO_ZM('2.4662120743304701014916113231545890427e-19') +  &
            TO_ZM('9.9999999999999999999999999999999999994e-51 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      NCASE = 1625
      M_X = TO_ZM('2.4662120743304701014916113231545890429e-19 + e-50 i')
      CALL ZM_TANH(M_X,M_Y)
      M_Z = TO_ZM('2.4662120743304701014916113231545890428e-19') +  &
            TO_ZM('9.9999999999999999999999999999999999994e-51 i')
      IF (.NOT.(M_Y == M_Z)) THEN
          CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
      ENDIF

      RETURN
      END SUBROUTINE TEST48

      SUBROUTINE TEST49

!  Round toward +infinity.

      IMPLICIT NONE

      CALL FMSETVAR(' MBASE = 10000 ')
      CALL FMSETVAR(' NDIG = 10 ')
      CALL FMSETVAR(' KROUND = 2 ')

      NCASE = 1626
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('5.000000000000000000000000000000000001e-40')
      M_C = M_A + M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768407')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1627
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
      M_C = M_A + M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768406')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1628
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('4.999999999999999999999999999999999999e-40')
      M_C = M_A + M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768406')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1629
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
      M_C = M_A + M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768405')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1630
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('5.000000000000000000000000000000000001e-40')
      M_C = M_A - M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768396')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1631
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
      M_C = M_A - M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768395')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1632
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('4.999999999999999999999999999999999999e-40')
      M_C = M_A - M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768397')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1633
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
      M_C = M_A - M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768396')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1634
      M_A = TO_FM('0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      M_C = M_A * M_B
      M_D = TO_FM('0.1598437505049341638922976633191829202699')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1635
      M_A = TO_FM('-0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      M_C = M_A * M_B
      M_D = TO_FM('-0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1636
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('0.2844558260571')
      M_C = M_A * M_B
      M_D = TO_FM('0.1981561046383759574134491155319378409099')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1637
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('-0.2844558260571')
      M_C = M_A * M_B
      M_D = TO_FM('-0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1638
      M_A = TO_FM('0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      MFMV1(1) = M_A + M_B
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.1598437505049341638922976633191829202699')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605757')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1639
      M_A = TO_FM('-0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      MFMV1(1) = -M_A + M_B
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1640
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = M_A + TO_FM('0.2844558260571')
      MFMV1(1) = TO_FM('0.2844558260571')
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541580')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.1981561046383759574134491155319378409099')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1641
      M_A = TO_FM('-0.696614681390281171833211321255418669')
      M_B = M_A + TO_FM('-0.2844558260571')
      MFMV1(1) = TO_FM('0.2844558260571')
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541580')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1642
      M_A = TO_FM('0.282941083469653908817180471388519729')
      MFMV1(1) = TO_FM('0.5649365180369')
      MFMV1(2) = M_A + TO_FM('0.5649365180369')
      MFMV1(3) = M_A + 2*TO_FM('0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.1598437505049341638922976633191829202699')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605757')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('0.3997431577248499881970027038678588808455')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1643
      M_A = TO_FM('-0.282941083469653908817180471388519729')
      MFMV1(1) = TO_FM('0.5649365180369')
      MFMV1(2) = -M_A + TO_FM('0.5649365180369')
      MFMV1(3) = -M_A + 2*TO_FM('0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('-0.3997431577248499881970027038678588808454')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1644
      M_A = TO_FM('0.696614681390281171833211321255418669')
      MFMV1(1) = M_A + TO_FM('0.2844558260571')
      MFMV1(2) = TO_FM('0.2844558260571')
      MFMV1(3) = M_A + 2*TO_FM('0.2844558260571')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541580')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.1981561046383759574134491155319378409099')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('0.8815842236052348640130150036752442950679')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1645
      M_A = TO_FM('0.696614681390281171833211321255418669')
      MFMV1(1) = M_A + TO_FM('0.2844558260571')
      MFMV1(2) = TO_FM('-0.2844558260571')
      MFMV1(3) = -M_A + 2*TO_FM('-0.2844558260571')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541580')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('-0.8815842236052348640130150036752442950678')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1646
      M_A = TO_FM('0.282941083469653908817180471388519729')
      MFMV1(1) = M_A + 2*TO_FM('0.5649365180369')
      MFMV1(2) = M_A + TO_FM('0.5649365180369')
      MFMV1(3) = TO_FM('0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.3997431577248499881970027038678588808455')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605757')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('0.1598437505049341638922976633191829202699')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1647
      M_A = TO_FM('0.282941083469653908817180471388519729')
      MFMV1(1) = -M_A + 2*TO_FM('-0.5649365180369')
      MFMV1(2) = M_A + TO_FM('0.5649365180369')
      MFMV1(3) = TO_FM('-0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-0.3997431577248499881970027038678588808454')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605757')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('-0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1648
      M_A = TO_FM('0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921')
      M_C = M_A / M_B
      M_D = TO_FM('0.5142899005070373097659012225902504129228')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1649
      M_A = TO_FM('-0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921')
      M_C = M_A / M_B
      M_D = TO_FM('-0.5142899005070373097659012225902504129227')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1650
      M_A = TO_FM('0.4693356799052036759819703352946208572489')
      M_B = TO_FM('0.2498185017524528219383570234374166958944')
      M_C = M_A / M_B
      M_D = TO_FM('1.878706647477504308190417437970331887')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1651
      M_A = TO_FM('0.4693356799052036759819703352946208572489')
      M_B = TO_FM('-0.2498185017524528219383570234374166958944')
      M_C = M_A / M_B
      M_D = TO_FM('-1.878706647477504308190417437970331886')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1652
      M_A = TO_FM('0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921') - M_A
      MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.5142899005070373097659012225902504129228')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.4857100994929626902340987774097495870773')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1653
      M_A = TO_FM('-0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921') + M_A
      MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-.5142899005070373097659012225902504129227')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.4857100994929626902340987774097495870773')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1654
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('0.4693356799052036759819703352946208572489')
      MFMV1(1) = TO_FM('0.2498185017524528219383570234374166958944')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('2.788483144777492522933050948973640361')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('1.878706647477504308190417437970331887')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1655
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('0.4693356799052036759819703352946208572489')
      MFMV1(1) = TO_FM('-0.2498185017524528219383570234374166958944')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-2.788483144777492522933050948973640360')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-1.878706647477504308190417437970331886')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      RETURN
      END SUBROUTINE TEST49

      SUBROUTINE TEST50

!  Round toward -infinity.

      IMPLICIT NONE

      CALL FMSETVAR(' MBASE = 10000 ')
      CALL FMSETVAR(' NDIG = 10 ')
      CALL FMSETVAR(' KROUND = -1 ')

      NCASE = 1656
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('5.000000000000000000000000000000000001e-40')
      M_C = M_A + M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768406')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1657
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
      M_C = M_A + M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768407')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1658
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('4.999999999999999999999999999999999999e-40')
      M_C = M_A + M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768405')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1659
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
      M_C = M_A + M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768406')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1660
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('5.000000000000000000000000000000000001e-40')
      M_C = M_A - M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768395')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1661
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
      M_C = M_A - M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768396')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1662
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('4.999999999999999999999999999999999999e-40')
      M_C = M_A - M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768396')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1663
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
      M_C = M_A - M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768397')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1664
      M_A = TO_FM('0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      M_C = M_A * M_B
      M_D = TO_FM('0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1665
      M_A = TO_FM('-0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      M_C = M_A * M_B
      M_D = TO_FM('-0.1598437505049341638922976633191829202699')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1666
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('0.2844558260571')
      M_C = M_A * M_B
      M_D = TO_FM('0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1667
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('-0.2844558260571')
      M_C = M_A * M_B
      M_D = TO_FM('-0.1981561046383759574134491155319378409099')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1668
      M_A = TO_FM('0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      MFMV1(1) = M_A + M_B
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1669
      M_A = TO_FM('-0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      MFMV1(1) = -M_A + M_B
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-0.1598437505049341638922976633191829202699')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.2398994072199158243047050405486759605757')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1670
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = M_A + TO_FM('0.2844558260571')
      MFMV1(1) = TO_FM('0.2844558260571')
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541579')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1671
      M_A = TO_FM('-0.696614681390281171833211321255418669')
      M_B = M_A + TO_FM('-0.2844558260571')
      MFMV1(1) = TO_FM('0.2844558260571')
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541579')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.1981561046383759574134491155319378409099')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1672
      M_A = TO_FM('0.282941083469653908817180471388519729')
      MFMV1(1) = TO_FM('0.5649365180369')
      MFMV1(2) = M_A + TO_FM('0.5649365180369')
      MFMV1(3) = M_A + 2*TO_FM('0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('0.3997431577248499881970027038678588808454')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1673
      M_A = TO_FM('-0.282941083469653908817180471388519729')
      MFMV1(1) = TO_FM('0.5649365180369')
      MFMV1(2) = -M_A + TO_FM('0.5649365180369')
      MFMV1(3) = -M_A + 2*TO_FM('0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-0.1598437505049341638922976633191829202699')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.2398994072199158243047050405486759605757')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('-0.3997431577248499881970027038678588808455')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1674
      M_A = TO_FM('0.696614681390281171833211321255418669')
      MFMV1(1) = M_A + TO_FM('0.2844558260571')
      MFMV1(2) = TO_FM('0.2844558260571')
      MFMV1(3) = M_A + 2*TO_FM('0.2844558260571')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541579')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('0.8815842236052348640130150036752442950678')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1675
      M_A = TO_FM('0.696614681390281171833211321255418669')
      MFMV1(1) = M_A + TO_FM('0.2844558260571')
      MFMV1(2) = TO_FM('-0.2844558260571')
      MFMV1(3) = -M_A + 2*TO_FM('-0.2844558260571')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541579')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.1981561046383759574134491155319378409099')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('-0.8815842236052348640130150036752442950679')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1676
      M_A = TO_FM('0.282941083469653908817180471388519729')
      MFMV1(1) = M_A + 2*TO_FM('0.5649365180369')
      MFMV1(2) = M_A + TO_FM('0.5649365180369')
      MFMV1(3) = TO_FM('0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.3997431577248499881970027038678588808454')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1677
      M_A = TO_FM('0.282941083469653908817180471388519729')
      MFMV1(1) = -M_A + 2*TO_FM('-0.5649365180369')
      MFMV1(2) = M_A + TO_FM('0.5649365180369')
      MFMV1(3) = TO_FM('-0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-0.3997431577248499881970027038678588808455')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('-0.1598437505049341638922976633191829202699')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1678
      M_A = TO_FM('0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921')
      M_C = M_A / M_B
      M_D = TO_FM('0.5142899005070373097659012225902504129227')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1679
      M_A = TO_FM('-0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921')
      M_C = M_A / M_B
      M_D = TO_FM('-0.5142899005070373097659012225902504129228')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1680
      M_A = TO_FM('0.4693356799052036759819703352946208572489')
      M_B = TO_FM('0.2498185017524528219383570234374166958944')
      M_C = M_A / M_B
      M_D = TO_FM('1.878706647477504308190417437970331886')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1681
      M_A = TO_FM('0.4693356799052036759819703352946208572489')
      M_B = TO_FM('-0.2498185017524528219383570234374166958944')
      M_C = M_A / M_B
      M_D = TO_FM('-1.878706647477504308190417437970331887')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1682
      M_A = TO_FM('0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921') - M_A
      MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.5142899005070373097659012225902504129227')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.4857100994929626902340987774097495870772')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1683
      M_A = TO_FM('-0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921') + M_A
      MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-.5142899005070373097659012225902504129228')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.4857100994929626902340987774097495870772')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1684
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('0.4693356799052036759819703352946208572489')
      MFMV1(1) = TO_FM('0.2498185017524528219383570234374166958944')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('2.788483144777492522933050948973640360')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('1.878706647477504308190417437970331886')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1685
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('0.4693356799052036759819703352946208572489')
      MFMV1(1) = TO_FM('-0.2498185017524528219383570234374166958944')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-2.788483144777492522933050948973640361')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-1.878706647477504308190417437970331887')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      RETURN
      END SUBROUTINE TEST50

      SUBROUTINE TEST51

!  Round toward zero.

      IMPLICIT NONE

      CALL FMSETVAR(' MBASE = 10000 ')
      CALL FMSETVAR(' NDIG = 10 ')
      CALL FMSETVAR(' KROUND = 0 ')

      NCASE = 1686
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('5.000000000000000000000000000000000001e-40')
      M_C = M_A + M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768406')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1687
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
      M_C = M_A + M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768406')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1688
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('4.999999999999999999999999999999999999e-40')
      M_C = M_A + M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768405')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1689
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
      M_C = M_A + M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768405')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1690
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('5.000000000000000000000000000000000001e-40')
      M_C = M_A - M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768395')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1691
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
      M_C = M_A - M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768395')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1692
      M_A = TO_FM('0.6283185307179586476925286766559005768401')
      M_B = TO_FM('4.999999999999999999999999999999999999e-40')
      M_C = M_A - M_B
      M_D = TO_FM('0.6283185307179586476925286766559005768396')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1693
      M_A = TO_FM('-0.6283185307179586476925286766559005768401')
      M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
      M_C = M_A - M_B
      M_D = TO_FM('-0.6283185307179586476925286766559005768396')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1694
      M_A = TO_FM('0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      M_C = M_A * M_B
      M_D = TO_FM('0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1695
      M_A = TO_FM('-0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      M_C = M_A * M_B
      M_D = TO_FM('-0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1696
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('0.2844558260571')
      M_C = M_A * M_B
      M_D = TO_FM('0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1697
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('-0.2844558260571')
      M_C = M_A * M_B
      M_D = TO_FM('-0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1698
      M_A = TO_FM('0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      MFMV1(1) = M_A + M_B
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1699
      M_A = TO_FM('-0.282941083469653908817180471388519729')
      M_B = TO_FM('0.5649365180369')
      MFMV1(1) = -M_A + M_B
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1700
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = M_A + TO_FM('0.2844558260571')
      MFMV1(1) = TO_FM('0.2844558260571')
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541579')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1701
      M_A = TO_FM('-0.696614681390281171833211321255418669')
      M_B = M_A + TO_FM('-0.2844558260571')
      MFMV1(1) = TO_FM('0.2844558260571')
      CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541579')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1702
      M_A = TO_FM('0.282941083469653908817180471388519729')
      MFMV1(1) = TO_FM('0.5649365180369')
      MFMV1(2) = M_A + TO_FM('0.5649365180369')
      MFMV1(3) = M_A + 2*TO_FM('0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('0.3997431577248499881970027038678588808454')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1703
      M_A = TO_FM('-0.282941083469653908817180471388519729')
      MFMV1(1) = TO_FM('0.5649365180369')
      MFMV1(2) = -M_A + TO_FM('0.5649365180369')
      MFMV1(3) = -M_A + 2*TO_FM('0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('-0.3997431577248499881970027038678588808454')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1704
      M_A = TO_FM('0.696614681390281171833211321255418669')
      MFMV1(1) = M_A + TO_FM('0.2844558260571')
      MFMV1(2) = TO_FM('0.2844558260571')
      MFMV1(3) = M_A + 2*TO_FM('0.2844558260571')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541579')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('0.8815842236052348640130150036752442950678')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1705
      M_A = TO_FM('0.696614681390281171833211321255418669')
      MFMV1(1) = M_A + TO_FM('0.2844558260571')
      MFMV1(2) = TO_FM('-0.2844558260571')
      MFMV1(3) = -M_A + 2*TO_FM('-0.2844558260571')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.6834281189668589065995658881433064541579')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-0.1981561046383759574134491155319378409098')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('-0.8815842236052348640130150036752442950678')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1706
      M_A = TO_FM('0.282941083469653908817180471388519729')
      MFMV1(1) = M_A + 2*TO_FM('0.5649365180369')
      MFMV1(2) = M_A + TO_FM('0.5649365180369')
      MFMV1(3) = TO_FM('0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.3997431577248499881970027038678588808454')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1707
      M_A = TO_FM('0.282941083469653908817180471388519729')
      MFMV1(1) = -M_A + 2*TO_FM('-0.5649365180369')
      MFMV1(2) = M_A + TO_FM('0.5649365180369')
      MFMV1(3) = TO_FM('-0.5649365180369')
      CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM,  &
                  MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-0.3997431577248499881970027038678588808454')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.2398994072199158243047050405486759605756')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(3)
      M_D = TO_FM('-0.1598437505049341638922976633191829202698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1708
      M_A = TO_FM('0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921')
      M_C = M_A / M_B
      M_D = TO_FM('0.5142899005070373097659012225902504129227')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1709
      M_A = TO_FM('-0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921')
      M_C = M_A / M_B
      M_D = TO_FM('-0.5142899005070373097659012225902504129227')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1710
      M_A = TO_FM('0.4693356799052036759819703352946208572489')
      M_B = TO_FM('0.2498185017524528219383570234374166958944')
      M_C = M_A / M_B
      M_D = TO_FM('1.878706647477504308190417437970331886')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1711
      M_A = TO_FM('0.4693356799052036759819703352946208572489')
      M_B = TO_FM('-0.2498185017524528219383570234374166958944')
      M_C = M_A / M_B
      M_D = TO_FM('-1.878706647477504308190417437970331886')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1712
      M_A = TO_FM('0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921') - M_A
      MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('0.5142899005070373097659012225902504129227')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.4857100994929626902340987774097495870772')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1713
      M_A = TO_FM('-0.4248927758509876073065623506584042361272')
      M_B = TO_FM('0.8261736725377782666616486764041757591921') + M_A
      MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-.5142899005070373097659012225902504129227')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('0.4857100994929626902340987774097495870772')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1714
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('0.4693356799052036759819703352946208572489')
      MFMV1(1) = TO_FM('0.2498185017524528219383570234374166958944')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('2.788483144777492522933050948973640360')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('1.878706647477504308190417437970331886')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1715
      M_A = TO_FM('0.696614681390281171833211321255418669')
      M_B = TO_FM('0.4693356799052036759819703352946208572489')
      MFMV1(1) = TO_FM('-0.2498185017524528219383570234374166958944')
      CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
      M_C = MFMV2(1)
      M_D = TO_FM('-2.788483144777492522933050948973640360')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF
      M_C = MFMV2(2)
      M_D = TO_FM('-1.878706647477504308190417437970331886')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      RETURN
      END SUBROUTINE TEST51

      SUBROUTINE TEST52

!  Test cases close to 1/2 ulp rounding error for special functions.

      IMPLICIT NONE

      CALL FMSETVAR(' MBASE = 10000 ')
      CALL FMSETVAR(' NDIG = 10 ')
      CALL FMSETVAR(' KROUND = 1 ')

      NCASE = 1716
      M_A = TO_FM('.2328386190529659228832053957071072125573')
      CALL FM_BERN(24,M_A,M_C)
      M_D = TO_FM('-20159.22657221596015247800092403139140')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1717
      M_A = TO_FM('.9451765100122574216552754520712319556089')
      CALL FM_BERN(24,M_A,M_C)
      M_D = TO_FM('-81833.62147384601623719886358367428881')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1718
      M_A = TO_FM('.5821684750579093589504314571127397718728')
      M_B = TO_FM('.5276586479483013778818324226131214725295')
      CALL FM_BETA(M_A,M_B,M_C)
      M_D = TO_FM('2.718685192837677534284224946262289328')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1719
      M_A = TO_FM('.0045177228684763844273939828899034713744')
      M_B = TO_FM('.7071703810032528448210532389136837995613')
      CALL FM_BETA(M_A,M_B,M_C)
      M_D = TO_FM('221.971401823711307460442393160140748062')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1720
      M_A = TO_FM('.2910233266900902429391868324973905211679')
      M_B = TO_FM('.2686978655316086409504709070690468302996')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('1.008221342235108731639228823278327453')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1721
      M_A = TO_FM('.1496244761646217127068665425798759041706')
      M_B = TO_FM('.5208004094353136060294490790695580983140')
      CALL FM_COMB(M_A,M_B,M_C)
      M_D = TO_FM('.7373815284360172522038196138611166769208')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1722
      M_A = TO_FM('.8818763003667274658259474897327495825393')
      CALL FM_FACT(M_A,M_C)
      M_D = TO_FM('.9556856818324261868773320949535856718209')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1723
      M_A = TO_FM('.4949226557823776089070415346269135914019')
      CALL FM_FACT(M_A,M_C)
      M_D = TO_FM('.8860734400698097304792845052056675778507')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1724
      M_A = TO_FM('.3761598409707025773715937538446685849102')
      CALL FM_GAM(M_A,M_C)
      M_D = TO_FM('2.362889562494552736407145620878970868')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1725
      M_A = TO_FM('.1672675981473020062920707493172560265625')
      CALL FM_GAM(M_A,M_C)
      M_D = TO_FM('5.545212721835892382245850289336741506')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1726
      M_A = TO_FM('.4614584565062692160383906583541987167546')
      M_B = TO_FM('.5951149438121376420146106335369913012772')
      M_C = TO_FM('.5135832693383946635459024061261877609871')
      CALL FM_IBTA(M_A,M_B,M_C,M_D)
      M_C = M_D
      M_D = TO_FM('1.175720760325729892558264431672632920')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1727
      M_A = TO_FM('.4081940034223790033948418644820959999190')
      M_B = TO_FM('.1180588713006268461672671906643209312650')
      M_C = TO_FM('.3149184009440604069173388778384328835109')
      CALL FM_IBTA(M_A,M_B,M_C,M_D)
      M_C = M_D
      M_D = TO_FM('7.900309247533697782193990826692658854')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1728
      M_A = TO_FM('.0427267171132272876071206331149137449302')
      M_B = TO_FM('.5105188999386855843675421276828724346974')
      CALL FM_IGM1(M_A,M_B,M_C)
      M_D = TO_FM('22.321595915082369762690531066589279138')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1729
      M_A = TO_FM('.4794594023597792560960161318337194611725')
      M_B = TO_FM('.4519909618067343602717438997268702891724')
      CALL FM_IGM1(M_A,M_B,M_C)
      M_D = TO_FM('1.241872690864524980937587750040289597')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1730
      M_A = TO_FM('.2261686600832506249009095185947406573375')
      M_B = TO_FM('.5015127240787333498711528283826321561631')
      CALL FM_IGM2(M_A,M_B,M_C)
      M_D = TO_FM('.5549442049131076957568567379492812192955')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1731
      M_A = TO_FM('.5094842013600974599082648516536815144934')
      M_B = TO_FM('.3482871781307067261980605367667982396401')
      CALL FM_IGM2(M_A,M_B,M_C)
      M_D = TO_FM('.7151073736823869119517083475220619366219')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1732
      M_A = TO_FM('.2068069932686212583647656539146963022688')
      CALL FM_LNGM(M_A,M_C)
      M_D = TO_FM('1.488657022360415732776205520278718644')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1733
      M_A = TO_FM('.1193692518130361861966262640397336872045')
      CALL FM_LNGM(M_A,M_C)
      M_D = TO_FM('2.067720011879939917820025488153571130')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1734
      M_A = TO_FM('.2576495214584462521245806915946723616023')
      CALL FM_PGAM(4,M_A,M_C)
      M_D = TO_FM('-21146.16261340494528903688834773180156')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1735
      M_A = TO_FM('.7962098719476029756078555617481483300242')
      CALL FM_PGAM(4,M_A,M_C)
      M_D = TO_FM('-76.473397969955670235128480927719957319')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1736
      M_A = TO_FM('.2903751291177076383370995341599159483511')
      CALL FM_POCH(M_A,10,M_C)
      M_D = TO_FM('226382.58826609244992525125582538977845')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1737
      M_A = TO_FM('.6535382063050879489012218891599782182586')
      CALL FM_POCH(M_A,10,M_C)
      M_D = TO_FM('1172527.33029198368051435459325948991873')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1738
      M_A = TO_FM('.6974141103846349693484255734679991971531')
      CALL FM_PSI(M_A,M_C)
      M_D = TO_FM('-1.227373681669287236661348744017575764')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1739
      M_A = TO_FM('.1489240375392748170922697013324334780161')
      CALL FM_PSI(M_A,M_C)
      M_D = TO_FM('-7.070608127091923241761976851770484074')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1740
      M_A = TO_FM('.1418132137659642168028407618412830046398')
      CALL FM_BESJ(2,M_A,M_C)
      M_D = TO_FM('.0025096630568893136653901659219379348639')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1741
      M_A = TO_FM('.1788169540762649644737416406458567693875')
      CALL FM_BESJ(2,M_A,M_C)
      M_D = TO_FM('.0039862981780302297384350008335271212665')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1742
      M_A = TO_FM('.5805890744092277015557299624869968071680')
      CALL FM_BESY(3,M_A,M_C)
      M_D = TO_FM('-27.170050571120923815100314544070890349')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1743
      M_A = TO_FM('.1727566160014456348350360062835911734820')
      CALL FM_BESY(3,M_A,M_C)
      M_D = TO_FM('-991.492233932025018825422382282585945571')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1744
      M_A = TO_FM('.4016568782932617682033356419955298473240')
      CALL FM_C(M_A,M_C)
      M_D = TO_FM('.3990851528696198643615325503826128715808')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1745
      M_A = TO_FM('.5530524251328989351390869029628343285806')
      CALL FM_C(M_A,M_C)
      M_D = TO_FM('.5404216519412922344321401126915592210606')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1746
      M_A = TO_FM('.3132698047591739833827682199637207397498')
      CALL FM_CHI(M_A,M_C)
      M_D = TO_FM('-0.5588397635338133878184786033023681883232')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1747
      M_A = TO_FM('.9021393609362524403130756737458658526952')
      CALL FM_CHI(M_A,M_C)
      M_D = TO_FM('.6847189967592175982961668075227015086895')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1748
      M_A = TO_FM('.4629298516778537800282633125284364103977')
      CALL FM_CI(M_A,M_C)
      M_D = TO_FM('-0.2460639652015249005042894314555107778450')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1749
      M_A = TO_FM('.0549423062812426822427336674003262253111')
      CALL FM_CI(M_A,M_C)
      M_D = TO_FM('-2.325010525455479068147552564259710333')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1750
      M_A = TO_FM('.6072730938561594792843888804993271348637')
      CALL FM_EI(M_A,M_C)
      M_D = TO_FM('.7919157659390910345415002387390308359006')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1751
      M_A = TO_FM('.9503051536465725719993585687558366320625')
      CALL FM_EI(M_A,M_C)
      M_D = TO_FM('1.759976172298062963545208718828109308')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1752
      M_A = TO_FM('.2340205975024858648191209097882767518758')
      CALL FM_EN(3,M_A,M_C)
      M_D = TO_FM('.3330926301696971928355749328109205940940')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1753
      M_A = TO_FM('.0400995594332772093627899515751956369449')
      CALL FM_EN(3,M_A,M_C)
      M_D = TO_FM('.4632389771805115242616797414710747077664')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1754
      M_A = TO_FM('.7886473371721963111084785258161883958469')
      CALL FM_ERF(M_A,M_C)
      M_D = TO_FM('.7352848658941150054408574269874333390461')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1755
      M_A = TO_FM('.7609436172163287325768460098497054081684')
      CALL FM_ERF(M_A,M_C)
      M_D = TO_FM('.7181339130361657639451467578071178631777')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1756
      M_A = TO_FM('.6100881772504833944803283072200079400836')
      CALL FM_ERFC(M_A,M_C)
      M_D = TO_FM('.3882502027357936095789040007851801672816')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1757
      M_A = TO_FM('.6243617029740179628590302641485755306347')
      CALL FM_ERFC(M_A,M_C)
      M_D = TO_FM('.3772466516971787018401366908961968549338')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1758
      M_A = TO_FM('.9707757617868134478807410067239461677428')
      CALL FM_LERC(M_A,M_C)
      M_D = TO_FM('-1.773202710864594278785176372612043038')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1759
      M_A = TO_FM('.5982919135705171840846535893551708254495')
      CALL FM_LERC(M_A,M_C)
      M_D = TO_FM('-.9225855862015127266997763635874449606237')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1760
      M_A = TO_FM('.3075187515156989643790009724751097014093')
      CALL FM_LI(M_A,M_C)
      M_D = TO_FM('-.1637252161858283068213216668816736669698')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1761
      M_A = TO_FM('.1187059517092358051891453031444894386999')
      CALL FM_LI(M_A,M_C)
      M_D = TO_FM('-.0408414304985139641159873359583412863556')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1762
      M_A = TO_FM('.5437226766721640071140744727072520535257')
      CALL FM_S(M_A,M_C)
      M_D = TO_FM('.0828773122511780478009671826497228619741')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1763
      M_A = TO_FM('.9617114410081342679366219277397124076033')
      CALL FM_S(M_A,M_C)
      M_D = TO_FM('.4000602273249795258822738271587288566974')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1764
      M_A = TO_FM('.8655870024154057721077141187964875276485')
      CALL FM_SHI(M_A,M_C)
      M_D = TO_FM('.9024368708930004866080405665890701363253')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1765
      M_A = TO_FM('.7550498406342259261861893754142408822008')
      CALL FM_SHI(M_A,M_C)
      M_D = TO_FM('.7793769513468371612732453792935391553448')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1766
      M_A = TO_FM('.7336740214990864267606810631343342550790')
      CALL FM_SI(M_A,M_C)
      M_D = TO_FM('.7120850765110427480344276510598853655741')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1767
      M_A = TO_FM('.8448202102736804118406485838696405421819')
      CALL FM_SI(M_A,M_C)
      M_D = TO_FM('.8120307046646463143924793647173595754174')
      IF (.NOT.(M_D == M_C)) THEN
          CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      RETURN
      END SUBROUTINE TEST52

      SUBROUTINE TEST53

!  Test special cases and error cases.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing special cases and error cases.')")

      MBASE = MXBASE
      CALL FMCONS
      NDIG = 2 + 52*DLOGTN/DLOGMB

!             Turn error message printing off while testing the error case code.

      CALL FMSETVAR(' KWARN = 0 ')
      M_A = 0

      NCASE = 1768
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMMPY(MA,MB,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.2565628653416941226485280051014985652035285365075991'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMMPY ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 1769
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMDIV(MA,MB,ME)
      CALL FMEQ(ME,MA)
      ST2 = '0.4788732394366197183098591549295774647887323943661972'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,ME)
      CALL FMEQ(ME,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRTFM('FMDIV ',MA,'MA',MC,'MC',MD,'MD')
      ENDIF

      NCASE = 1770
      M_A = TO_FM('10')
      M_B = TO_FM('5.3')
      CALL FM_BETA(M_A,M_B,M_C)
      M_D = TO_FM('7.0836036771097107530120640698518155187687458162734679M-5')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1771
      M_A = TO_FM('0.1')
      M_B = TO_FM('23.4')
      M_C = TO_FM('34.5')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('5.8731980918960730463350151650813268739874201571164800M-27')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1772
      M_A = TO_FM('8.115640517330775M-1')
      M_B = TO_FM('2.00853601446773')
      M_C = TO_FM('1.59735792202923')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.0112520048150164306467955877563719782378767062440103M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1773
      M_A = TO_FM('9.01737835258975M-1')
      M_B = TO_FM('2.00853601446773')
      M_C = TO_FM('1.59735792202923')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.2512248738228585976753517954889151150428002974819213M-1')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1774
      M_A = TO_FM('9.6097615596216720E-01')
      M_B = TO_FM('1.970425178583792')
      M_C = TO_FM('5.5680052333367')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.8619456987740165364092968281459448023932520843535423M-2')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1775
      M_A = TO_FM('4.764360371097952E-01')
      M_B = TO_FM('1.161514683661584E+01')
      M_C = TO_FM('2.937801562768354E-01')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('2.3604503996731113868791517339909092506365724801689105M-5')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 1776
      M_A = TO_FM('0.9')
      M_B = TO_FM('23.4')
      M_C = TO_FM('34.5')
      CALL FM_IBTA(M_A,M_B,M_C,MFM6)
      CALL FM_EQ(MFM6,M_C)
      M_D = TO_FM('7.3148127865937299821246829407023943740949130742928268M-18')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      CALL ZMSET(50)
      CALL ZM_SET(50)
      CALL FMSET(50)

      NCASE = 1777
      MIM3 = 1
      MIM4 = 0
      MIM5 = MIM3/MIM4
      IF (MWK(START(MIM5%MIM)+2) /= MUNKNO .OR. MWK(START(MIM5%MIM)) /= 1) CALL PRTERR(KW)

      NCASE = 1778
      MIM5 = MIM3*MIM5
      IF (MWK(START(MIM5%MIM)+2) /= MUNKNO .OR. MWK(START(MIM5%MIM)) /= 1) CALL PRTERR(KW)

      NCASE = 1779
      MIM4 = 1.23E+23
      MFM4 = MIM4
      MFM5 = TO_FM('1.23E+23')
      IF (.NOT. ABS((MFM5-MFM4)/MFM5) < RSMALL) CALL PRTERR(KW)

      NCASE = 1780
      MIM4 = 1.23D+45
      MFM4 = MIM4
      MFM5 = TO_FM('1.23D+45')
      IF (.NOT. ABS((MFM5-MFM4)/MFM5) < DSMALL) CALL PRTERR(KW)

      NCASE = 1781
      MIM4 = CMPLX(1.23E+23,9.87E+24)
      MFM4 = MIM4
      MFM5 = TO_FM('1.23E+23')
      IF (.NOT. ABS((MFM5-MFM4)/MFM5) < RSMALL) CALL PRTERR(KW)

      NCASE = 1782
      MIM4 = CMPLX(1.23D+23,9.87D+24, KIND(0.0D0))
      MFM4 = MIM4
      MFM5 = TO_FM('1.23D+23')
      IF (.NOT. ABS((MFM5-MFM4)/MFM5) < DSMALL) CALL PRTERR(KW)

      NCASE = 1783
      CALL FM_ST2M('1.23',MFMV1(1))
      CALL FM_ST2M('2.23',MFMV1(2))
      CALL FM_ST2M('3.23',MFMV1(3))
      CALL FM_ST2M('4.23',MFMV3(1))
      CALL FM_ST2M('5.23',MFMV3(2))
      MFM3 = DOT_PRODUCT(MFMV1,MFMV3)
      IF (MWK(START(MFM3%MFM)+2) /= MUNKNO) CALL PRTERR(KW)

      NCASE = 1784
      CALL IM_ST2M('12',MIMV1(1))
      CALL IM_ST2M('23',MIMV1(2))
      CALL IM_ST2M('34',MIMV1(3))
      CALL IM_ST2M('-14',MIMV3(1))
      CALL IM_ST2M('-5',MIMV3(2))
      MIM3 = DOT_PRODUCT(MIMV1,MIMV3)
      IF (MWK(START(MIM3%MIM)+2) /= MUNKNO) CALL PRTERR(KW)

      NCASE = 1785
      CALL ZM_ST2M('1.23 + 1.67 i',MZMV1(1))
      CALL ZM_ST2M('2.23 - 2.56 i',MZMV1(2))
      CALL ZM_ST2M('3.23 + 3.45 i',MZMV1(3))
      CALL ZM_ST2M('4.23 - 4.34 i',MZMV3(1))
      CALL ZM_ST2M('5.23 + 5.23 i',MZMV3(2))
      MZM3 = DOT_PRODUCT(MZMV1,MZMV3)
      IF (MWK(START(MZM3%MZM(1))+2) /= MUNKNO) CALL PRTERR(KW)

      NCASE = 1786
      DO I = 1, 3
         DO J = 1, 3
            MFMA(I,J) = 3*(J-1) + I
         ENDDO
      ENDDO
      DO I = 1, 2
         DO J = 1, 2
            MFMD(I,J) = 3*(J-1) + I
         ENDDO
      ENDDO
      MFME = MATMUL(MFMA,MFMD)
      IF (MWK(START(MFME(1,1)%MFM)+2) /= MUNKNO) CALL PRTERR(KW)

      NCASE = 1787
      DO I = 1, 2
         DO J = 1, 2
            MIMA(I,J) = 2*(J-1) + I + 20
         ENDDO
      ENDDO
      DO I = 1, 3
         DO J = 1, 2
            MIMD(I,J) = 2*(J-1) + I + 20
         ENDDO
      ENDDO
      MIMC = MATMUL(MIMA,MIMD)
      IF (MWK(START(MIMC(1,1)%MIM)+2) /= MUNKNO) CALL PRTERR(KW)

      NCASE = 1788
      DO I = 1, 2
         DO J = 1, 3
            MZMA(I,J) = CMPLX(TO_FM(2*(J-1)+I+10),TO_FM(2*(J-1)+I+20))
         ENDDO
      ENDDO
      DO I = 1, 2
         DO J = 1, 4
            MZMC(I,J) = CMPLX(TO_FM(4*(I-1)+J+50),TO_FM(4*(I-1)+J+30))
         ENDDO
      ENDDO
      MZMC = MATMUL(MZMA,MZMC)
      IF (MWK(START(MZMC(1,1)%MZM(1))+2) /= MUNKNO) CALL PRTERR(KW)

      NCASE = 1789
      MFM4 = HUGE(MFM1)
      MFM3 = SCALE(MFM4,12)
      IF (MWK(START(MFM3%MFM)+2) /= MEXPOV) CALL PRTERR(KW)

      NCASE = 1790
      MZM4 = HUGE(MFM1)
      MZM3 = SCALE(MZM4,12)
      IF (MWK(START(MZM3%MZM(1))+2) /= MEXPOV) CALL PRTERR(KW)

      RETURN
      END SUBROUTINE TEST53

      SUBROUTINE TEST54

!  Test packed array routines and error messages.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing packed array routines and error messages.')")

!             Turn error message printing on while testing the error case code, and write the
!             error messages on unit 22.

      CALL FMSETVAR(' KWARN = 1 ')

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')
      CALL FMSETVAR(' NTRACE = -2 ')
      CALL FMSETVAR(' LVLTRC = 1 ')
      CALL FMSETVAR(' MBASE = 10000 ')
      CALL FMSETVAR(' NDIG = 14 ')

      NCASE = 1791
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('-1.67',MP1)
      CALL FPABS(MP1,MP3)
      CALL FPST2M('1.67',MP4)
      IF (.NOT.FPCOMPARE(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1792
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPST2M('8374251785837425178583792',MP3)
      CALL IPEQ(MP3,MP2)
      CALL IPDIVR(MP1,MP2,MP5,MP4)
      CALL IPST2M('3666412140861684892372583',MP3)
      IF (.NOT.(IPCOMPARE(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1793
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPM2DP(MP1,D1)
      CALL FPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL FPM2DP(MP1,D3)
      IF (.NOT. (ABS(D3-D1) < DSMALL)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1794
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('0',MP1)
      MBLOGS = 0
      CALL FPACOS(MP1,MP3)
      CALL FPPI(MP2)
      CALL FPDIVI(MP2,2,MP4)
      CALL FPSUB(MP3,MP4,MP2)
      CALL FPEQ(MP2,MP3)
      CALL FPABS(MP3,MP2)
      CALL FPST2M('1.0E-49',MP1)
      IF (.NOT.FPCOMPARE(MP2,'<',MP1)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1795
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('-UNDERFLOW',MP1)
      CALL FPACOS(MP1,MP3)
      CALL FPPI(MP2)
      CALL FPDIVI(MP2,2,MP4)
      CALL FPSUB(MP3,MP4,MP2)
      CALL FPEQ(MP2,MP3)
      CALL FPABS(MP3,MP2)
      CALL FPST2M('1.0E-49',MP1)
      IF (.NOT.FPCOMPARE(MP2,'<',MP1)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1796
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      KRAD = 0
      CALL FPST2M('-0.5',MP1)
      CALL FPACOS(MP1,MP3)
      CALL FPST2M('120',MP4)
      KRAD = 1
      IF (.NOT.FPCOMPARE(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1797
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('1.7654',MP1)
      MBLOGS = 0
      CALL FPACOSH(MP1,MP3)
      CALL FPST2M('1.16946418704054815282376713618783111908417864000514252424243757',MP4)
      CALL FPSUB(MP3,MP4,MP2)
      CALL FPEQ(MP2,MP3)
      CALL FPABS(MP3,MP2)
      CALL FPST2M('1.0E-49',MP1)
      IF (.NOT.FPCOMPARE(MP2,'<',MP1)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1798
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('24.662120743304701014916113231545890428',MP1)
      CALL FPST2M('19.598731519274866200933093993663363141',MP2)
      MBLOGS = 0
      CALL FPHYPOT(MP1,MP2,MP3)
      CALL FPST2M('31.5012773823849581936652001656744299068083994252835506543708',MP4)
      CALL FPSUB(MP3,MP4,MP2)
      CALL FPEQ(MP2,MP3)
      CALL FPABS(MP3,MP2)
      CALL FPST2M('1.0E-49',MP1)
      IF (.NOT.FPCOMPARE(MP2,'<',MP1)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF


      NCASE = 1799
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMSETVAR(' NTRACE = -1 ')
      CALL FPST2M('12.0',MP1)
      CALL FPST2M('13.0',MP2)
      MBLOGS = 0
      CALL FPADD(MP1,MP2,MP3)
      CALL FPST2M('25.0',MP4)
      IF (.NOT.FPCOMPARE(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1800
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('12.0',MP1)
      CALL FPST2M('13.0',MP2)
      J = KDEBUG
      KDEBUG = 1
      CALL FPADD(MP1,MP2,MP3)
      KDEBUG = J
      CALL FPST2M('25.0',MP4)
      IF (.NOT.FPCOMPARE(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1801
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('12.0',MP1)
      CALL FPST2M('13.0',MP2)
      J = KDEBUG
      KDEBUG = 1
      CALL FPSUB(MP1,MP2,MP3)
      KDEBUG = J
      CALL FPST2M('-1.0',MP4)
      IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1802
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('12.0',MP1)
      CALL FPST2M('0.0',MP2)
      J = KDEBUG
      KDEBUG = 1
      CALL FPADD(MP1,MP2,MP3)
      KDEBUG = J
      CALL FPST2M('12.0',MP4)
      IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1803
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('12.0',MP1)
      CALL FPST2M('0.0',MP2)
      J = KDEBUG
      KDEBUG = 1
      CALL FPSUB(MP1,MP2,MP3)
      KDEBUG = J
      CALL FPST2M('12.0',MP4)
      IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1804
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPBIG(MP1)
      CALL FPBIG(MP2)
      CALL FPADD(MP1,MP2,MP3)
      IF (.NOT.(MWK(START(MP3)+2) == MEXPOV)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1805
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPBIG(MP1)
      CALL FPI2M(0,MP3)
      CALL FPSUB(MP3,MP1,MP2)
      CALL FPSUB(MP1,MP2,MP3)
      IF (.NOT.(MWK(START(MP3)+2) == MEXPOV)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1806
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPTINY(MP1)
      CALL FPDIVI(MP1,2,MP3)
      IF (.NOT.(MWK(START(MP3)+2) == MEXPUN)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1807
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMSETVAR(' NTRACE = -2 ')
      CALL FPST2M('12.0',MP1)
      CALL FPST2M('13.0',MP2)
      MBLOGS = 0
      CALL FMUNPK(MP1,MA)
      CALL FMUNPK(MP2,MB)
      CALL FMADD_R1(MA,MB)
      CALL FMPACK(MA,MP1)
      CALL FPEQ(MP1,MP3)
      CALL FPST2M('25.0',MP4)
      IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1808
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPACOS(ZP1,ZP4)
      CALL ZPST2M('0.70600062465538060328041859335986022136042273675348823497' &
       // ' - 0.71156604883917677179467491357721581085120933977853167363 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1809
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMSETVAR(' NTRACE = 2 ')
      CALL FM_SET(50)
      CALL FPST2M('12.0',MP1)
      CALL FPST2M('13.0',MP2)
      J = KDEBUG
      KDEBUG = 1
      CALL FMUNPK(MP1,MA)
      CALL FMUNPK(MP2,MB)
      CALL FMADD_R1(MA,MB)
      CALL FMPACK(MA,MP1)
      CALL FPEQ(MP1,MP3)
      KDEBUG = J
      CALL FPST2M('25.0',MP4)
      IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1810
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('12.0',MP1)
      CALL FPST2M('0.0',MP2)
      J = KDEBUG
      KDEBUG = 1
      CALL FMUNPK(MP1,MA)
      CALL FMUNPK(MP2,MB)
      CALL FMADD_R1(MA,MB)
      CALL FMPACK(MA,MP1)
      CALL FPEQ(MP1,MP3)
      KDEBUG = J
      CALL FPST2M('12.0',MP4)
      IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1811
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPBIG(MP1)
      CALL FPBIG(MP2)
      CALL FMUNPK(MP1,MA)
      CALL FMUNPK(MP2,MB)
      CALL FMADD_R1(MA,MB)
      CALL FMPACK(MA,MP1)
      CALL FPEQ(MP1,MP3)
      IF (.NOT.(MWK(START(MP3)+2) == MEXPOV)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1812
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMST2M(' 1.732050808 ',MA)
      CALL FMPRINT(MA)

      NCASE = 1813
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FM_ST2M(' 1.732050808 ',M_A)
      CALL FM_PRINT(M_A)

      NCASE = 1814
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IM_ST2M(' 11732050808 ',M_J)
      CALL IM_PRINT(M_J)

      NCASE = 1815
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IM_ST2M(' 11732050808 ',M_J)
      CALL IMPRINT(M_J%MIM)

      NCASE = 1816
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMFPRINT(' F12.7 ',MA)

      NCASE = 1817
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMFPRINT(' ES25.15 ',MA)

      NCASE = 1818
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMFPRINT(' 1PE25.15 ',MA)

      NCASE = 1819
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMFPRINT(' E25.15 ',MA)

      NCASE = 1820
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FM_FPRINT(' F12.7 ',M_A)

      NCASE = 1821
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      M_J = 12343
      CALL IMFPRINT(' I10 ',M_J%MIM)

      NCASE = 1822
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      M_J = 12343
      CALL IM_FPRINT(' I10 ',M_J)

      NCASE = 1823
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZM_ST2M(' 1.23 - 4.56 i ',M_Z)
      CALL ZM_FPRINT(' F12.7 ',' F12.7 ',M_Z)

      NCASE = 1824
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZMST2M(' 1.23 - 4.56 i ',ZA)
      CALL ZMFPRINT(' F12.7 ',' F12.7 ',ZA)

      NCASE = 1825
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FM_FPRINT(' F12.7 ',M_A)

      NCASE = 1826
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      LINE = (/ '1','.','7','3','2','0','5','0','8','1' /)
      CALL FMINP(LINE,MA,1,10)
      CALL FMFPRINT(' F14.9 ',MA)

      NCASE = 1827
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      LINE = (/ '1','.','7','3','2','0','5','0','8','1' /)
      CALL FM_INP(LINE,M_A,1,10)
      CALL FM_FPRINT(' F14.9 ',M_A)

      NCASE = 1828
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      LINE = (/ '1','2','7','3','2','0','5','0','8','1' /)
      CALL IM_INP(LINE,M_J,1,10)
      CALL IM_FPRINT(' F14.9 ',M_J)

      NCASE = 1829
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      LINE = (/ '1','.','7','3','2','-','5','.','8','i' /)
      CALL ZM_INP(LINE,M_Z,1,10)
      CALL ZM_FPRINT(' F14.9 ',' F14.9 ',M_Z)

      NCASE = 1830
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      LINE = (/ '1','.','7','3','2','-','5','.','8','i' /)
      CALL ZMINP(LINE,ZA,1,10)
      CALL ZMFPRINT(' F14.9 ',' F14.9 ',ZA)

      NCASE = 1831
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FM_OUT(M_A,LINE2,80)
      WRITE (22,*) LINE2

      NCASE = 1832
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IM_OUT(M_J,LINE2,80)
      WRITE (22,*) LINE2

      NCASE = 1833
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZM_OUT(M_Z,LINE3,160,L1,L2)
      WRITE (22,*) LINE3(1:L1)
      WRITE (22,*) LINE3(L1+1:L2)

      NCASE = 1834
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZM_PRINT(M_Z)

      NCASE = 1835
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZMPRINT(M_Z%MZM)

      NCASE = 1836
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      OPEN (23,FILE='TEMPFM')
      CALL FMWRITE(23,MA)
      CLOSE(23)
      OPEN (23,FILE='TEMPFM')
      CALL FMREAD(23,MB)
      CLOSE(23)
      IF (.NOT.FMCOMP(MA,'==',MB)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1837
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      OPEN (23,FILE='TEMPFM')
      CALL FM_WRITE(23,M_A)
      CLOSE(23)
      OPEN (23,FILE='TEMPFM')
      CALL FM_READ(23,M_B)
      CLOSE(23)
      IF (.NOT.FMCOMP(MA,'==',MB)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1838
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IMST2M(' 8765432 ',MA)
      OPEN (23,FILE='TEMPFM')
      CALL IM_WRITE(23,M_J)
      CLOSE(23)
      OPEN (23,FILE='TEMPFM')
      CALL IM_READ(23,M_K)
      CLOSE(23)
      IF (.NOT.IM_COMP(M_J,'==',M_K)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1839
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      OPEN (23,FILE='TEMPFM')
      CALL IM_WRIT(23,M_J)
      CLOSE(23)
      OPEN (23,FILE='TEMPFM')
      CALL IM_READ(23,M_K)
      CLOSE(23)
      IF (.NOT.IM_COMP(M_J,'==',M_K)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1840
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      OPEN (23,FILE='TEMPFM')
      CALL ZMWRITE(23,ZA)
      CLOSE(23)
      OPEN (23,FILE='TEMPFM')
      CALL ZMREAD(23,ZB)
      CLOSE(23)
      CALL ZMSUB(ZA,ZB,ZC)
      CALL ZMABS(ZC,MA)
      IF (.NOT.(MWK(START(MA)+3)==0)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1841
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      M_X = TO_ZM(' 123456789.0123 + .00000000000987654321098765 i ')
      OPEN (23,FILE='TEMPFM')
      CALL ZM_WRITE(23,M_X)
      CLOSE(23)
      OPEN (23,FILE='TEMPFM')
      CALL ZM_READ(23,M_Y)
      CLOSE(23)
      CALL ZM_SUB(M_X,M_Y,M_Z)
      CALL ZM_ABS(M_Z,M_A)
      IF (.NOT.(M_A==0)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST54

      END MODULE TEST_C


      MODULE TEST_D
      USE TEST_VARS

      CONTAINS

      SUBROUTINE TEST55

!  Test packed array routines and error messages.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 1842
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MAXINT = 31
      CALL FMSET(50)

      NCASE = 1843
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MAXINT = HUGE(MAXINT)
      CALL FMSET(50)

      NCASE = 1844
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      INTMAX = 31
      CALL FMSET(50)

      NCASE = 1845
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      INTMAX = HUGE(INTMAX)
      CALL FMSET(50)

      NCASE = 1846
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      DPMAX = 31
      CALL FMSET(50)

      NCASE = 1847
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      DPMAX = HUGE(DPMAX)
      CALL FMSET(50)

      NCASE = 1848
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      SPMAX = 31
      CALL FMSET(50)

      NCASE = 1849
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      SPMAX = HUGE(SPMAX)
      CALL FMSET(50)

      NCASE = 1850
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MXBASE = 31
      CALL FMSET(50)

      NCASE = 1851
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MXBASE = HUGE(MXBASE)
      CALL FMSET(50)

      NCASE = 1852
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMSET(123456789)
      CALL FMSET(50)

      NCASE = 1853
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MXEXP2 = 31
      CALL FMSET(50)

      NCASE = 1854
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MXEXP2 = HUGE(MXEXP2)
      CALL FMSET(50)

      NCASE = 1855
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MEXPUN = 31
      CALL FMSET(50)

      NCASE = 1856
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MEXPUN = -(HUGE(MEXPUN)/2)
      CALL FMSET(50)

      NCASE = 1857
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MEXPOV = 31
      CALL FMSET(50)

      NCASE = 1858
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MEXPOV = HUGE(MEXPOV)
      CALL FMSET(50)

      NCASE = 1859
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MUNKNO = 31
      CALL FMSET(50)

      NCASE = 1860
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      MUNKNO = HUGE(MUNKNO)
      CALL FMSET(50)

      NCASE = 1861
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      DPEPS = 31
      CALL FMSET(50)

      NCASE = 1862
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      DPEPS = TINY(DPEPS)
      CALL FMSET(50)

      NCASE = 1863
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMST2M(' UNDERFLOW ',MA)
      CALL FMACOS(MA,MB)

      NCASE = 1864
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMST2M(' UNDERFLOW ',MA)
      CALL FMI2M(2,MB)
      CALL FMSUB_R1(MA,MB)

      NCASE = 1865
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMST2M(' UNDERFLOW ',MA)
      CALL FMI2M(2,MB)
      MBLOGS = 0
      CALL FMADD_R2(MA,MB)

      NCASE = 1866
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMST2M(' UNDERFLOW ',MA)
      CALL FMI2M(2,MB)
      MBLOGS = 0
      CALL FMSUB_R2(MA,MB)

      NCASE = 1867
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMST2M(' UNDERFLOW ',MA)
      CALL FMI2M(2,MB)
      MBLOGS = 0
      CALL FMSUB_R2(MB,MA)

      NCASE = 1868
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMST2M(' UNDERFLOW ',MA)
      CALL FMI2M(2,MB)
      CALL FMSUB_R1(MB,MA)

      NCASE = 1869
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMBIG(MA)
      CALL FMBIG(MB)
      CALL FMADD_R1(MB,MA)

      NCASE = 1870
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMBIG(MA)
      CALL FMBIG(MB)
      CALL FMADD_R2(MB,MA)

      NCASE = 1871
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMBIG(MA)
      CALL FMBIG(MB)
      MWK(START(MB)) = -1
      CALL FMSUB_R1(MB,MA)

      NCASE = 1872
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMBIG(MA)
      CALL FMBIG(MB)
      MWK(START(MB)) = -1
      CALL FMSUB_R2(MB,MA)

      NCASE = 1873
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      KRAD = 1
      CALL FMBIG(MA)
      CALL FMRATIONAL_POWER(MA,2,3,MB)
      CALL FMI2M(1,MC)
      CALL FMDIV(MC,MB,MA)
      CALL FMATAN2(MA,MB,MC)

      NCASE = 1874
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      KRAD = 1
      CALL FMST2M(' OVERFLOW ',MA)
      CALL FMST2M(' -OVERFLOW ',MB)
      CALL FMATAN2(MA,MB,MC)

      NCASE = 1875
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      KRAD = 1
      CALL FMST2M(' OVERFLOW ',MA)
      CALL FMST2M(' OVERFLOW ',MB)
      CALL FMSUB_R2(MA,MB)

      NCASE = 1876
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      KRAD = 1
      CALL FMBIG(MA)
      CALL FMRATIONAL_POWER(MA,2,3,MB)
      CALL FMCOS(MB,MC)

      NCASE = 1877
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      KRAD = 1
      CALL FMBIG(MA)
      CALL FMRATIONAL_POWER(MA,2,3,MB)
      CALL FMI2M(1,MC)
      CALL FMDIV(MC,MB,MA)
      CALL FMEXP(MA,MC)

      NCASE = 1878
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMST2M(' 9.87654321 ',MA)
      CALL FMADDI(MA,1)
      CALL FMST2M(' 10.87654321 ',MB)
      IF (.NOT.FMCOMP(MA,'==',MB)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1879
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMI2M(0,MA)
      CALL FMI2M(10,MB)
      CALL FMSUB_R2(MA,MB)

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST55

      SUBROUTINE TEST56

!  Test packed array routines and error messages.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 1880
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('12.3',MP1)
      CALL FPST2M('13.4',MP2)
      MBLOGS = 0
      CALL FPADD_R1(MP1,MP2)
      CALL FPEQ(MP1,MP3)
      CALL FPST2M('25.7',MP4)
      IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1881
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('12.3',MP1)
      CALL FPST2M('13.4',MP2)
      MBLOGS = 0
      CALL FPADD_R2(MP1,MP2)
      CALL FPEQ(MP2,MP3)
      CALL FPST2M('25.7',MP4)
      IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1882
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP1)
      CALL FPASIN(MP1,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '-0.1549366595480165482162668772711462026055032526229215'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1883
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP1)
      CALL FPASINH(MP1,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '-0.15371150629581261264064074147602400563488601232863865993318169'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1884
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP1)
      CALL FPACOS(MP1,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '1.72573298634291316744758856891089764470408795231047443'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1885
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP1)
      CALL FPATAN(MP1,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '-0.1531097611932166866656026454043044303832710577681088'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1886
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '0.94560848060096528389929229868402683067804981169173247'
      CALL FPST2M(ST1,MP1)
      ST1 = '-0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP2)
      CALL FPATAN2(MP1,MP2,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '1.73256418659578182618854912685922800721811839353964281'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1887
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP1)
      CALL FPATANH(MP1,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '-0.15556029109708269346385810732889430739725390446117551460013646'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1888
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP1)
      CALL FPCOSH_SINH(MP1,MP5,MP3)
      CALL FPEQ(MP5,MP1)
      ST2 = '1.01193059616357146189046397247688618707733939978160410'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-49',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1889
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP1)
      CALL FPCOSH_SINH(MP1,MP3,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '-0.1549307311412463123459415264870282740222134044307085'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-49',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1890
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.94560848060096528389929229868402683067804981169173247'
      CALL FPST2M(ST1,MP1)
      CALL FPCOSH(MP1,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '1.481411250434183525381236609413838568985012681608897254'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-49',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1891
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.94560848060096528389929229868402683067804981169173247'
      CALL FPST2M(ST1,MP1)
      CALL FPSINH(MP1,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '-1.09296811157186613424915073409970877381016076745694536'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-49',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1892
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.28774393113505190047124972239269330732580050085069004'
      CALL FPST2M(ST1,MP1)
      CALL FPCOS_SIN(MP1,MP5,MP3)
      CALL FPEQ(MP5,MP1)
      ST2 = '0.958886564221161298875708475997367442261190043299635289'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
      ENDIF

      NCASE = 1893
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.28774393113505190047124972239269330732580050085069004'
      CALL FPST2M(ST1,MP1)
      CALL FPCOS_SIN(MP1,MP3,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '-0.28378963504000055007660394052727537030693318515060125'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1894
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPDIG(NSTACK,KST)

      NCASE = 1895
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FPST2M(ST1,MP1)
      ST1 = '0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP2)
      CALL FPDIM(MP1,MP2,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '0.1961979460329520811830831348163129844349414342734330'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1896
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FPST2M(ST1,MP1)
      ST1 = '0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP2)
      CALL FPDIM(MP2,MP1,MP5)
      CALL FPEQ(MP5,MP1)
      ST2 = '0.0'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1897
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP1)
      ST1 = '0.94560848060096528389929229868402683067804981169173247'
      CALL FPST2M(ST1,MP2)
      CALL FPDIV_R1(MP1,MP2)
      ST2 = '-0.1631938810304448993189068089843600996344185378132402'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1898
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP1)
      ST1 = '0.94560848060096528389929229868402683067804981169173247'
      CALL FPST2M(ST1,MP2)
      CALL FPDIV_R2(MP1,MP2)
      CALL FPEQ(MP2,MP1)
      ST2 = '-0.1631938810304448993189068089843600996344185378132402'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1899
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMFLAG(J)
      IF (.NOT.J==0) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1900
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FM_FLAG(J)
      IF (.NOT.J==0) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1901
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPFLAG(J)
      IF (.NOT.J==0) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1902
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '-0.1543175178845736920127931538434808299980482564482165'
      CALL FPST2M(ST1,MP1)
      CALL FPDIVI_R1(MP1,314)
      ST2 = '-4.9145706332666780895793998039325105094919826894336465M-4'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('1.0E-50',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1903
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPDP2M(3.1415926536D0,MP1)
      ST2 = '3.1415926536D0'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPDPM(DSMALL,MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1904
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPDP2M(3.1415926536D0,MP1)
      ST2 = '3.1415926536D0'
      CALL FPST2M(ST2,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQU(MP5,MP4,NDIG,NDIG)
      CALL FPDPM(DSMALL,MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      CALL FMSETVAR(' MBASE = 2 ')
      CALL FMSETVAR(' NDIG = 100 ')

      NCASE = 1905
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '3.1415926536D0'
      CALL FPST2M(ST1,MP1)
      CALL FPEQU_R1(MP1,100,53)
      CALL FPDP2M(3.1415926536D0,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPDPM(DSMALL,MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1906
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPI2M(1,MP1)
      CALL FPDIVI(MP1,3,MP2)
      CALL FPI2M(3,MP3)
      CALL FPDIVI(MP3,7,MP1)
      CALL ZPCOMPLEX(MP2,MP1,ZP1)
      CALL FPI2M(2,MP1)
      CALL FPDIVI(MP1,11,MP2)
      CALL FPI2M(5,MP3)
      CALL FPDIVI(MP3,-13,MP1)
      CALL ZPCOMPLEX(MP2,MP1,ZP2)
      CALL ZPMPY(ZP2,ZP1,ZP3)
      CALL ZP2I2M(677,-151,ZP2)
      CALL ZPDIVI(ZP2,3003,ZP4)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-28 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1907
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('0.1',MP1)
      CALL FPST2M('23.4',MP2)
      CALL FPST2M('34.5',MP3)
      CALL FPIBTA(MP1,MP2,MP3,MP5)
      CALL FPEQ(MP5,MP3)
      CALL FPST2M('5.8731980918960730463350151650813268739874201571164800M-27',&
                  MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-28',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1908
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('8.115640517330775M-1',MP1)
      CALL FPST2M('2.00853601446773',MP2)
      CALL FPST2M('1.59735792202923',MP3)
      CALL FPIBTA(MP1,MP2,MP3,MP5)
      CALL FPEQ(MP5,MP3)
      CALL FPST2M('2.0112520048150164306467955877563719782378767062440103M-1',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-28',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1909
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.01737835258975M-1',MP1)
      CALL FPST2M('2.00853601446773',MP2)
      CALL FPST2M('1.59735792202923',MP3)
      CALL FPIBTA(MP1,MP2,MP3,MP5)
      CALL FPEQ(MP5,MP3)
      CALL FPST2M('2.2512248738228585976753517954889151150428002974819213M-1',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-28',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1910
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPST2M('5.5680052333367',MP3)
      CALL FPIBTA(MP1,MP2,MP3,MP5)
      CALL FPEQ(MP5,MP3)
      CALL FPST2M('2.8619456987740165364092968281459448023932520843535423M-2',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-28',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1911
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('4.764360371097952E-01',MP1)
      CALL FPST2M('1.161514683661584E+01',MP2)
      CALL FPST2M('2.937801562768354E-01',MP3)
      CALL FPIBTA(MP1,MP2,MP3,MP5)
      CALL FPEQ(MP5,MP3)
      CALL FPST2M('2.3604503996731113868791517339909092506365724801689105M-5',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-28',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1912
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('0.9',MP1)
      CALL FPST2M('23.4',MP2)
      CALL FPST2M('34.5',MP3)
      CALL FPIBTA(MP1,MP2,MP3,MP5)
      CALL FPEQ(MP5,MP3)
      CALL FPST2M('7.3148127865937299821246829407023943740949130742928268M-18',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-28',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      CALL FMSET(50)

      NCASE = 1913
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      ST1 = '1.3505154639175257731958762886597938144329896907216495E+16'
      CALL FPST2M(ST1,MP1)
      CALL FPFORM('F53.33',MP1,ST2)
      CALL FPST2M(ST2,MP1)
      ST1 = '13505154639175257.731958762886597938144329896907216'
      CALL FPST2M(ST1,MP3)
      CALL FPSUB(MP1,MP3,MP4)
      CALL FPABS(MP4,MP5)
      CALL FPEQ(MP5,MP4)
      CALL FPST2M('0',MP2)
      IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1914
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPFPRINT(' F12.7 ',MP1)

      NCASE = 1915
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      LINE = (/ '1','.','7','3','2','0','5','0','8','1' /)
      CALL FPINP(LINE,MP1,1,10)
      CALL FPFPRINT(' F14.9 ',MP1)

      NCASE = 1916
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPDP2M(3.1415926536D0,MP1)
      CALL FPINT(MP1,MP4)
      CALL FPI2M(3,MP2)
      IF (.NOT.FPCOMP(MP4,'EQ',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1917
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('23.4',MP1)
      CALL FPIPOWER(MP1,3141,MP3)
      CALL FPST2M('5.09340400268261822666046780299885179315709583071835M+4300',&
                  MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST56

      SUBROUTINE TEST57

!  Test packed array routines and error messages.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 1918
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('23.4',MP1)
      CALL FPLOG10(MP1,MP3)
      CALL FPST2M('1.36921585741014283901029985917705207599817679823056854M+0',&
                  MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1919
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPLNI(314159,MP3)
      CALL FPST2M('1.26576545061554068013063698538579804967961002514885554M+1',&
                  MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1920
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('1.26576545061554068013063698538579804967961002514885554M+1',&
                  MP4)
      CALL FPM2DP(MP4,D4)
      D3 = 12.6576545061554068013063698538D0
      IF (.NOT.(ABS((D3-D4)/D3) <= DSMALL)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1921
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('1.26576545061554068013063698538579804967961002514885554M+1',&
                  MP4)
      CALL FPM2I(MP4,J4)
      J3 = 12
      IF (.NOT.(J3 == J4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1922
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('1.26576545061554068013063698538579804967961002514885554M+1',&
                  MP4)
      CALL FPM2SP(MP4,R4)
      R3 = 12.6576545061554068013063698538D0
      IF (.NOT.(ABS((R3-R4)/R3) <= RSMALL)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1923
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPMAX(MP1,MP2,MP3)
      CALL FPEQ(MP2,MP4)
      IF (.NOT.(FPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1924
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPMIN(MP1,MP2,MP3)
      CALL FPEQ(MP1,MP4)
      IF (.NOT.(FPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1925
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPMOD(MP2,MP1,MP3)
      CALL FPST2M('4.84728666594576M-2',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1926
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPMPY_R1(MP2,MP1)
      CALL FPEQ(MP2,MP3)
      CALL FPST2M('1.8935316137265192583672271140224',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1927
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPMPY_R2(MP2,MP1)
      CALL FPEQ(MP1,MP3)
      CALL FPST2M('1.8935316137265192583672271140224',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1928
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPMPYI_R1(MP1,3141)
      CALL FPEQ(MP1,MP3)
      CALL FPST2M('3.0184261058771671752M+3',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1929
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPNINT(MP2,MP3)
      CALL FPST2M('2',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1930
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPOUT(MP2,LINE2,80)
      WRITE (22,*) LINE2

      NCASE = 1931
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPPRINT(MP2)

      NCASE = 1932
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPPOWER(MP1,MP2,MP3)
      CALL FPST2M('9.2456296989927890349870950485447101281994309260378M-1',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1933
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.2456296989927890349870950485447101281994309260378M-1',MP1)
      OPEN (23,FILE='TEMPFM')
      CALL FPWRITE(23,MP1)
      CLOSE(23)
      OPEN (23,FILE='TEMPFM')
      CALL FPREAD(23,MP2)
      CLOSE(23)
      IF (.NOT.FPCOMP(MP1,'==',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1934
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M(' 8765432 ',MP1)
      OPEN (23,FILE='TEMPFM')
      CALL IPWRITE(23,MP1)
      CLOSE(23)
      OPEN (23,FILE='TEMPFM')
      CALL IPREAD(23,MP2)
      CLOSE(23)
      IF (.NOT.IPCOMPARE(MP1,'==',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1935
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M(' 8765432 - 3.1415926535 i ',ZP1)
      OPEN (23,FILE='TEMPFM')
      CALL ZPWRITE(23,ZP1)
      CLOSE(23)
      OPEN (23,FILE='TEMPFM')
      CALL ZPREAD(23,ZP2)
      CLOSE(23)
      CALL ZPSUB(ZP1,ZP2,ZP3)
      CALL ZPABS(ZP3,MP1)
      IF (.NOT.(MWK(START(MP1)+3)==0)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF
      CALL FPSET(50)
      CALL ZPSET(50)
      CALL FPSETVAR(' KROUND = 1 ')

      NCASE = 1936
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPRATIONAL_POWER(MP1,-17,3,MP3)
      CALL FPST2M('1.2530311443238039320917124735975084865516365445493',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1937
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('1.970425178583792',MP2)
      CALL FPSIGN(MP1,MP2,MP3)
      CALL FPST2M('9.6097615596216720E-01',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1938
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('-1.970425178583792',MP2)
      CALL FPSIGN(MP1,MP2,MP3)
      CALL FPST2M('-9.6097615596216720E-01',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1939
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPSP2M(9.6097615596216720E-01,MP1)
      CALL FPEQ(MP1,MP3)
      CALL FPST2M('9.6097615596216720E-01',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPDP2M(DBLE(RSMALL),MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1940
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('-1.970425178583792',MP1)
      CALL FPSQR(MP1,MP3)
      CALL FPST2M('3.882575384396968595370765099264',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1941
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('-1.970425178583792',MP1)
      CALL FPSQR_R1(MP1)
      CALL FPEQ(MP1,MP3)
      CALL FPST2M('3.882575384396968595370765099264',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1942
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('1.970425178583792',MP1)
      CALL FPSQRT(MP1,MP3)
      CALL FPST2M('1.4037183401892959523361955370723206435382400513186',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1943
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('1.970425178583792',MP1)
      CALL FPSQRT_R1(MP1)
      CALL FPEQ(MP1,MP3)
      CALL FPST2M('1.4037183401892959523361955370723206435382400513186',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1944
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('-1.970425178583792',MP2)
      CALL FPSUB_R1(MP1,MP2)
      CALL FPEQ(MP1,MP3)
      CALL FPST2M('2.9314013345459592',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1945
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('9.6097615596216720E-01',MP1)
      CALL FPST2M('-1.970425178583792',MP2)
      CALL FPSUB_R2(MP1,MP2)
      CALL FPEQ(MP2,MP3)
      CALL FPST2M('2.9314013345459592',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1946
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('1.970425178583792',MP1)
      CALL FPTAN(MP1,MP3)
      CALL FPST2M('-2.367672024680099040477317736673741484868333249781053',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1947
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('1.970425178583792',MP1)
      CALL FPTANH(MP1,MP3)
      CALL FPST2M('0.96187741826338453069125363260768470953417284943678332',MP4)
      CALL FPSUB(MP3,MP4,MP1)
      CALL FPDIV(MP1,MP4,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1948
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('0.970425178583792',MP1)
      CALL FPULP(MP1,MP4)
      CALL FPST2M('1.0E-49',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST57

      SUBROUTINE TEST58

!  Test packed array routines and error messages.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')
      CALL FMSETVAR(' KDEBUG = 1 ')
      CALL FMSETVAR(' NTRACE = 0 ')

      NCASE = 1949
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPBIG(MP1)

      NCASE = 1950
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('1',MP2)
      CALL IPADD(MP1,MP2,MP3)
      CALL FMSETVAR(' NTRACE = -2 ')

      NCASE = 1951
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('-97042517858374251785837425178583792',MP1)
      CALL IPABS(MP1,MP4)
      CALL IPST2M('97042517858374251785837425178583792',MP3)
      IF (.NOT.(IPCOMPARE(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1952
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('-97042517858374251785837425178583792',MP1)
      CALL IPST2M('9618774182633845306912536326076847095',MP2)
      CALL IPADD(MP1,MP2,MP4)
      CALL IPST2M('9521731664775471055126698900898263303',MP3)
      IF (.NOT.(IPCOMPARE(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1953
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('9618774182633845306912536326076847095',MP1)
      CALL IPST2M('97042517858374251785837425178583792',MP2)
      CALL IPDIM(MP1,MP2,MP4)
      CALL IPST2M('9521731664775471055126698900898263303',MP3)
      IF (.NOT.(IPCOMPARE(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1954
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPST2M('97042517858374251785837425178583792',MP2)
      CALL IPDIV(MP1,MP2,MP4)
      CALL IPST2M('9911917368706',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1955
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPDIVI(MP1,141421356,MP4)
      CALL IPST2M('6801500462655615681490949353260002232803',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1956
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPST2M('8374251785837425178583792',MP2)
      CALL IPDIVR(MP1,MP2,MP4,MP5)
      CALL IPST2M('114861296610416734545911',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1957
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPST2M('8374251785837425178583792',MP2)
      CALL IPDIVR(MP1,MP2,MP5,MP4)
      CALL IPST2M('3666412140861684892372583',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1958
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPDVIR(MP1,314159,MP4,K)
      CALL IPST2M('3061753501454309858037853950596202993790013',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1959
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPDVIR(MP1,314159,MP4,K)
      CALL IPI2M(K,MP4)
      CALL IPST2M('153028',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1960
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPFACT(42,MP1)
      CALL IPST2M('1405006117752879898543142606244511569936384000000000',MP3)
      IF (.NOT.(IPCOMP(MP1,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1961
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPFORM('I60',MP1,ST1)
      WRITE (22,*) TRIM(ST1)
      CALL IPFORM('I65',MP1,ST1)
      WRITE (22,*) TRIM(ST1)
      CALL IPFORM('I70',MP1,ST1)
      WRITE (22,*) TRIM(ST1)
      CALL IPFPRINT('I55',MP1)

      NCASE = 1962
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPFM2I(MP1,MP4)
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1963
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPST2M('501617681971661768197016151614655',MP2)
      CALL IPGCD(MP1,MP2,MP4)
      CALL IPST2M('2995',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1964
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPI2FM(MP1,MP4)
      CALL FPST2M('961877418263384530691314159265352536326076847095',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1965
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      LINE = (/ '1','2','7','3','2','0','5','0','8','1' /)
      CALL IPINP(LINE,MP1,1,10)
      CALL IPFPRINT(' I19 ',MP1)

      NCASE = 1966
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('9618774',MP1)
      CALL IPM2I(MP1,J)
      IF (.NOT.(J==9618774)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1967
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352',MP1)
      CALL IPST2M('501617681971661768197016151614655',MP2)
      CALL IPMAX(MP1,MP2,MP4)
      CALL IPEQ(MP1,MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1968
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352',MP1)
      CALL IPST2M('501617681971661768197016151614655',MP2)
      CALL IPMIN(MP1,MP2,MP4)
      CALL IPEQ(MP2,MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1969
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
      CALL IPST2M('501617681971661768197016151614655',MP2)
      CALL IPMOD(MP1,MP2,MP4)
      CALL IPST2M('145259323199683353738381582948755',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1970
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159',MP1)
      CALL IPST2M('501617681971661768197016151',MP2)
      CALL IPMPY(MP1,MP2,MP4)
      CALL IPST2M('482494720890165508515231424715486981447117196737982009',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1971
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('9618774182633845306913141592653525363260768479',MP1)
      CALL IPMPYI(MP1,27182818,MP4)
      CALL IPST2M('261465387989634577617974069721330917007901356104793822',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1972
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159',MP1)
      CALL IPST2M('501617681971661768197016151',MP2)
      CALL IPST2M('890165508515231424715486981',MP3)
      CALL IPMPY_MOD(MP1,MP2,MP3,MP4)
      CALL IPST2M('858797890729021380597497877',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1973
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159',MP1)
      CALL IPPRINT(MP1)
      CALL IPOUT(MP1,LINE2,80)
      WRITE (22,*) LINE2

      NCASE = 1974
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159',MP1)
      CALL IPST2M('501617681971661768197016151',MP2)
      CALL IPST2M('890165508515231424715486981',MP3)
      CALL IPPOWER_MOD(MP1,MP2,MP3,MP4)
      CALL IPST2M('633132741667454490327909790',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1975
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('3',MP1)
      CALL IPST2M('99',MP2)
      CALL IPPOWER(MP1,MP2,MP4)
      CALL IPST2M('171792506910670443678820376588540424234035840667',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1976
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159',MP1)
      CALL IPST2M('-501617681971661768197016151',MP2)
      CALL IPSIGN(MP1,MP2,MP4)
      CALL IPST2M('-961877418263384530691314159',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1977
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159',MP1)
      CALL IPSQR(MP1,MP4)
      CALL IPST2M('925208167765033988714377447579006734179035806433877281',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1978
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL IPST2M('961877418263384530691314159',MP1)
      CALL IPST2M('-501617681971661768197016151',MP2)
      CALL IPSUB(MP1,MP2,MP4)
      CALL IPST2M('1463495100235046298888330310',MP3)
      IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST58

      SUBROUTINE TEST59

!  Test packed array routines and error messages.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 1979
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPACOS(ZP1,ZP4)
      CALL ZPST2M('0.70600062465538060328041859335986022136042273675348823497' &
       // ' - 0.71156604883917677179467491357721581085120933977853167363 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1980
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPACOSH(ZP1,ZP4)
      CALL ZPST2M('0.7115660488391767717946749135772158108512093397785316736309103' &
       // ' + 0.706000624655380603280418593359860221360422736753488234970530511 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1981
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      C2 = ( 411.11D0 , 421.21D0 )
      CALL ZPZ2M(C2,ZP1)
      CALL ZPM2Z(ZP1,C3)
      IF (.NOT.(ABS(C2-C3)<=10*RSMALL)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1982
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M(' UNKNOWN + UNKNOWN i',ZP1)
      CALL ZPABS(ZP1,MP1)

      NCASE = 1983
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPST2M('.806032804185933598602213 - .677179467491357721581085 i',ZP2)
      CALL ZPADD(ZP1,ZP2,ZP4)
      CALL ZPST2M('1.767910222449318129295372 - .175561785519695959610924 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1984
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPADDI(ZP1,23)
      CALL ZPEQ(ZP1,ZP4)
      CALL ZPST2M('23.961877418263384530693159 + .501617681971661761970161 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1985
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPARG(ZP1,MP2)
      CALL FPST2M('.480698159960890424820899647062999936490174031143315855',MP3)
      CALL FPSUB(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1986
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPASIN(ZP1,ZP4)
      CALL ZPST2M('0.86479570213951601595090309827989122073816196293406467551' &
       // ' + 0.71156604883917677179467491357721581085120933977853167363 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1987
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPASINH(ZP1,ZP4)
      CALL ZPST2M('0.900207272015178844823089941054098242773062607541078739877027' &
       // ' + 0.35754352192968121012869758291917347170198797130828159120183063 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1988
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPATAN(ZP1,ZP4)
      CALL ZPST2M('0.83122857933580380367837122090555657350450640595902544783' &
       // ' + 0.24920779958101410179847467515196375836302942974441567571 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1989
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPATANH(ZP1,ZP4)
      CALL ZPST2M('0.696301009291630587124616922905971442353634900594022530558111' &
       // ' + 0.87263127573022465079716048906002337234036921023338585331161049 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1990
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPCOSH_SINH(ZP1,ZP4,ZP5)
      CALL ZPST2M('1.31467350963913258828454157251213529780144052082464935752' &
       // ' + 0.53720666283416318345036206080606650334019117579553972797 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1991
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPCOSH_SINH(ZP1,ZP4,ZP5)
      CALL ZPEQ(ZP5,ZP4)
      CALL ZPST2M('.979580485714651735857744392650346362731955914349750961769' &
       // ' + 0.72097329329143451318183379449877600176209183488881542857 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1992
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPCOSH_SINH(ZP1,ZP4,ZP5)
      CALL ZPEQ(ZP5,ZP4)
      CALL FPST2M('.979580485714651735857744392650346362731955914349750962',MP1)
      CALL FPST2M('.720973293291434513181833794498776001762091834888815429',MP2)
      CALL ZPCOMPLEX(MP1,MP2,ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1993
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPCOSH_SINH(ZP1,ZP4,ZP5)
      CALL ZPEQ(ZP5,ZP4)
      CALL FPST2M('.979580485714651735857744392650346362731955914349750962',MP1)
      CALL FPST2M('-.72097329329143451318183379449877600176209183488881543',MP2)
      CALL ZPCOMPLEX(MP1,MP2,ZP5)
      CALL ZPCONJUGATE(ZP5,ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1994
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPCOSH(ZP1,ZP4)
      CALL ZPST2M('1.31467350963913258828454157251213529780144052082464935752' &
       // ' + 0.53720666283416318345036206080606650334019117579553972797 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1995
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPSINH(ZP1,ZP4)
      CALL ZPST2M('.979580485714651735857744392650346362731955914349750961769' &
       // ' + 0.72097329329143451318183379449877600176209183488881542857 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1996
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPCOS_SIN(ZP1,ZP4,ZP5)
      CALL ZPST2M('.645463644587284986570788327890260087314797257046253121008' &
       // ' - 0.42893405213103227551382784541030693750489674471244174226 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1997
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPCOS_SIN(ZP1,ZP4,ZP5)
      CALL ZPEQ(ZP5,ZP4)
      CALL ZPST2M('.925646878732852518234454333124909696895019818561899130649' &
       // ' + 0.29910038367448814287423577861472924609286011958848280525 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1998
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPCOS(ZP1,ZP4)
      CALL ZPST2M('.645463644587284986570788327890260087314797257046253121008' &
       // ' - 0.42893405213103227551382784541030693750489674471244174226 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 1999
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPSIN(ZP1,ZP4)
      CALL ZPST2M('.925646878732852518234454333124909696895019818561899130649' &
       // ' + 0.29910038367448814287423577861472924609286011958848280525 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2000
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPST2M('.806032804185933598602213 - .677179467491357721581085 i',ZP2)
      CALL ZPDIV(ZP1,ZP2,ZP4)
      CALL ZPST2M('.393065886385899116192752703080718648267156986016216110380' &
       // ' + .952559034342193734113670482385007317974710202767761766583 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2001
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPDIVI(ZP1,17,ZP3)
      CALL ZPEQU(ZP3,ZP4,NDIG,NDIG)
      CALL ZPST2M('.056581024603728501805479941176470588235294117647058823529' &
       // ' + .029506922468921280115891823529411764705882352941176470588 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2002
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPEXP(ZP1,ZP4)
      CALL ZPST2M('2.29425399535378432414228596516248166053339643517440031928' &
       // ' + 1.25817995612559769663219585530484250510228301068435515654 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2003
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 '  &
       //'- 5.221238938053097345132743362831858407079646017699115M+3 i'
      CALL ZPST2M(STZ1,ZP1)
      CALL ZPFORM('F53.33','F50.30',ZP1,STZ2)
      CALL ZPFPRINT('F53.33','F50.30',ZP1)
      CALL ZPST2M(STZ2,ZP1)
      STZ1 = '7699.115044247787610619469026548673 - 5221.238938053097345132743362831858 i'
      CALL ZPST2M(STZ1,ZP3)
      CALL ZPSUB(ZP1,ZP3,ZP4)
      CALL ZPABS(ZP4,MP1)
      CALL FPI2M(10,MP2)
      CALL FPIPOWER(MP2,-30,MP5)
      CALL FPEQ(MP5,MP2)
      IF (.NOT.FPCOMP(MP1,'LE',MP2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2004
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPIMAG(ZP1,MP2)
      CALL FPST2M('.501617681971661761970161',MP3)
      CALL FPSUB(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2005
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('961.877418263384530693159 - 50161.7681971661761970161 i',ZP1)
      CALL ZPINT(ZP1,ZP4)
      CALL ZPST2M('961 - 50161 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2006
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPIPOWER(ZP1,-17,ZP3)
      CALL ZPEQU(ZP3,ZP4,NDIG,NDIG)
      CALL ZPST2M('-0.0783198382158008596797674342388290245832366478080809199' &
       // ' - 0.23802087499028856650937161618337776943798676633749916344 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPEQU_R1(ZP2,NDIG,NDIG)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2007
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPLOG10(ZP1,ZP4)
      CALL ZPST2M('0.03535658255837767759890583679877500609113178092547835860' &
       // ' + 0.20876455833206137887867112816112836681425288379320453778 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2008
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPLN(ZP1,ZP4)
      CALL ZPST2M('0.08141153993813371843860406013667319698707451321662014634' &
       // ' + 0.48069815996089042482089964706299993649017403114331585543 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2009
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZP2I2M(311,242,ZP1)
      CALL ZPLN(ZP1,ZP4)
      CALL ZPST2M('5.97650870861072332214638522053994842350413381557547832020' &
       // ' + 0.66126573728680700894734815861149103459820486160667323526 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2010
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZP2I2M(0,1,ZP2)
      CALL ZPI2M(242,ZP1)
      CALL ZPMPY(ZP2,ZP1,ZP3)
      CALL ZPI2M(311,ZP2)
      CALL ZPADD(ZP2,ZP3,ZP1)
      CALL ZPLN(ZP1,ZP4)
      CALL ZPST2M('5.97650870861072332214638522053994842350413381557547832020' &
       // ' + 0.66126573728680700894734815861149103459820486160667323526 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2011
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      LINE = (/ '1','.','7','3','2','-','5','.','8','i' /)
      CALL ZPINP(LINE,ZP3,1,10)
      CALL ZPFPRINT(' F14.9 ',' F14.9 ',ZP3)

      NCASE = 2012
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZP2I2M(0,1,ZP2)
      CALL ZPI2M(242,ZP1)
      CALL ZPMPY(ZP2,ZP1,ZP3)
      CALL ZPI2M(311,ZP2)
      CALL ZPADD(ZP2,ZP3,ZP1)
      CALL ZPM2I(ZP1,K)
      CALL ZPI2M(K,ZP4)
      CALL ZPI2M(311,ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2013
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPST2M('.806032804185933598602213 - .677179467491357721581085 i',ZP2)
      CALL ZPMPY(ZP1,ZP2,ZP4)
      CALL ZPST2M('1.114989947487781115990363612078996929155913365552' &
       // ' - 0.247043331062694339517150562789101008517858731222 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2014
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPMPYI(ZP1,63387,ZP4)
      CALL ZPST2M('60970.523911461155247047269533 + 31796.040007137724106002595307 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2015
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('7.46187741826338453069315 - 11.5016176819716617619701 i',ZP1)
      CALL ZPNINT(ZP1,ZP4)
      CALL ZPST2M('7 - 12 I',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2016
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('7.4618774182633845306931 - 11.5016176819716617619701 i',ZP1)
      CALL ZPOUT(ZP1,LINE3,160,L1,L2)
      WRITE (22,*) LINE3(1:L1)
      WRITE (22,*) LINE3(L1+1:L2)
      CALL ZPPRINT(ZP1)

      NCASE = 2017
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPST2M('.806032804185933598602213 - .677179467491357721581085 i',ZP2)
      CALL ZPPOWER(ZP1,ZP2,ZP4)
      CALL ZPST2M('1.39775982163051551688131453335764913350785862824257646215' &
       // ' + 0.48240656957195221898158057319722954101453374897327805790 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2018
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPREAL(ZP1,MP4)
      CALL FPST2M('0.961877418263384530693159',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2019
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPRATIONAL_POWER(ZP1,2,3,ZP4)
      CALL ZPST2M('1.00202360107782552892042821152548849581875484236296485859' &
       // ' + 0.33257768446397834834871578362882211629744208653087094696 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2020
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPSQR(ZP1,ZP4)
      CALL ZPST2M('0.67358786889841078726210758566713980197275503336' &
       // ' + 0.964989441780331005053370946075151648549609657198 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2021
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPSQRT(ZP1,ZP4)
      CALL ZPST2M('1.01160631388938404645144168377130820925509481210302287649' &
       // ' + 0.24793127281059658860683266919655766045064329364530970818 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2022
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPTAN(ZP1,ZP4)
      CALL ZPST2M('0.78117053617929045357436659926266970251614000121758973149' &
       // ' + 0.98250464217661207723158350609409132905007077433947956202 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2023
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
      CALL ZPTANH(ZP1,ZP4)
      CALL ZPST2M('0.83052827119349045667199695567558847711641456190882938853' &
       // ' + 0.20903134528783898803996574942036149916960793736034264482 i',ZP3)
      CALL ZPSUB(ZP4,ZP3,ZP2)
      CALL ZPABS(ZP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST59

      SUBROUTINE TEST60

!  Test packed array routines and error messages.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2024
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPBERN(6,MP1,MP4)
      CALL FPST2M('.018139938530080584064122845276611475515756237384957075',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2025
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.76187741826338453069315950161768197166176197016819E-30',MP1)
      CALL FPBERN(56,MP1,MP4)
      CALL FPST2M('-2.1712568779835074200430675247025298102245771733788731',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2026
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPBERNOULLI(754,MP4)
      CALL FPST2M('2.46143453963085054575745389497735050525111549008129322M+1242',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP4)
      CALL FPABS(MP4,MP2)
      CALL FPEQ(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2027
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('UNKNOWN',MP1)
      CALL FPST2M('.384530693159501617681971661761970168197166161761877418',MP2)
      CALL FPBETA(MP1,MP2,MP4)

      NCASE = 2028
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPST2M('.384530693159501617681971661761970168197166161761877418',MP2)
      CALL FPBETA(MP1,MP2,MP4)
      CALL FPST2M('2.99150917174738777323834998550737132112608848764083126',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2029
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPCMBI(52,7,MP4)
      CALL FPST2M('133784560',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2030
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FMSETVAR(' NTRACE = 0 ')
      CALL FPCMBI(152,47,MP4)
      CALL FPST2M('4688795937593084907665736021700474766400',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2031
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPCMBI(524,257,MP4)
      CALL FPST2M('1.7394867054111349048750219854973569921796001236423E156',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF
      CALL FMSETVAR(' NTRACE = 2 ')

      NCASE = 2032
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPST2M('.384530693159501617681971661761970168197166161761877418',MP2)
      CALL FPCOMB(MP1,MP2,MP4)
      CALL FPST2M('1.16776225886340871791424789455418366405513640340362234',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2033
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPEULER(MP4)
      CALL FPST2M('0.57721566490153286060651209008240243104215933593992360',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2034
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPFACT(MP1,MP4)
      CALL FPST2M('0.92181747044639815204253427093098440709300519155172509',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2035
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPST2M('.384530693159501617681971661761970168197166161761877418',MP2)
      CALL FPIGM1(MP1,MP2,MP4)
      CALL FPST2M('0.54012222681292420650853318537501826484216332470115287',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2036
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPST2M('.384530693159501617681971661761970168197166161761877418',MP2)
      CALL FPIGM2(MP1,MP2,MP4)
      CALL FPST2M('0.66980662571505767554186612265050822469259270495177049',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2037
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPLNGM(MP1,MP4)
      CALL FPST2M('0.19056155831623627284176293227248235560520674439064473',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2038
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPPGAM(12,MP1,MP4)
      CALL FPST2M('-1.6437610934504989650413401960008051459064634656830e10',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2039
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPPSI(MP1,MP4)
      CALL FPST2M('-1.0560385061434708930901856824702932941189426061196201',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPABS(MP2,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2040
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPPOCH(MP1,19,MP4)
      CALL FPST2M('4.96330494211633715298220189277411152814525032466164E16',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST60

      SUBROUTINE TEST61

!  Test special functions BESJ, ..., SI.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing special functions Bessel J, ..., Sine integral.')")

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2041
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPBESJ(1,MP1,MP4)
      CALL FPST2M('0.35395934550649481043706011910726694906877434623666577',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2042
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_BESJ(1,M_A,M_C)
      M_D = TO_FM('0.025076313747902851151016887592625714022097197246242295753')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('BESJ  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2043
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = BESSEL_J(1,M_A)
      M_D = TO_FM('0.580613481388098517450802341770789762709610311496482470588')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('BESJ  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2044
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
      CALL FPBESJ(2,MP1,MP4)
      CALL FPST2M('-.01952848241900729944980296190098199680508467281412306',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2045
      M_A = TO_FM('10.76313747902851151016887592625714022')
      M_C = BESSEL_J0(M_A)
      M_D = TO_FM('-0.208312158576553370144898171757804508454706793929928218991535')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('BES_J0',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2046
      M_A = TO_FM('11.76313747902851151016887592625714022')
      M_C = BESSEL_J1(M_A)
      M_D = TO_FM('-0.2329271333218008613387948290084894573276990964794253279143')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('BES_J1',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2047
      M_A = TO_FM('25.76313747902851151016887592625714022')
      M_C = BESSEL_JN(5,M_A)
      M_D = TO_FM('0.0508922548494461703324004764815922773488007444429836272407555')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('BES_JN',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2048
      M_A = TO_FM('35.76313747902851151016887592625714022')
      MFMV2 = BESSEL_JN(0,2,M_A)
      DO J = 1, 3
         M_D = BESSEL_J(J-1,M_A)
         IF (.NOT.(M_D == MFMV2(J))) THEN
             CALL ERRPRT_FM('BES_JN',M_A,'M_A',MFMV2(J),'M_C',M_D,'M_D')
         ENDIF
      ENDDO

      NCASE = 2049
      M_A = TO_FM('45.76313747902851151016887592625714022')
      MFMV2 = BESSEL_JN(5,7,M_A)
      DO J = 1, 3
         M_D = BESSEL_J(J+4,M_A)
         IF (.NOT.(M_D == MFMV2(J))) THEN
             CALL ERRPRT_FM('BES_JN',M_A,'M_A',MFMV2(J),'M_C',M_D,'M_D')
         ENDIF
      ENDDO

      NCASE = 2050
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPBESY(1,MP1,MP4)
      CALL FPST2M('-1.0229628883608938340543466176704780443299917729340212',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2051
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
      CALL FPBESY(3,MP1,MP4)
      CALL FPST2M('.019458484184348814542380224640044909138243842997041552',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2052
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_BESY(1,M_A,M_C)
      M_D = TO_FM('0.415283138512818266781669706694859586834446116171226914427')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BESY ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2053
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = BESSEL_Y(1,M_A)
      M_D = TO_FM('-0.24596633539686028736976213837495696096219154732970115661')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' BESY ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2054
      M_A = TO_FM('10.76313747902851151016887592625714022')
      M_C = BESSEL_Y0(M_A)
      M_D = TO_FM('-0.12526481112719290404360204423259007560755779258223692939574')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('BES_Y0',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2055
      M_A = TO_FM('11.76313747902851151016887592625714022')
      M_C = BESSEL_Y1(M_A)
      M_D = TO_FM('-0.003248393370801429476804249855075203160449295789759231111044843')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('BES_Y1',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2056
      M_A = TO_FM('25.76313747902851151016887592625714022')
      M_C = BESSEL_YN(5,M_A)
      M_D = TO_FM('-0.150310703577113473623573293096522058774420127187598125599602')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('BES_YN',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2057
      M_A = TO_FM('35.76313747902851151016887592625714022')
      MFMV2 = BESSEL_YN(0,2,M_A)
      DO J = 1, 3
         M_D = BESSEL_Y(J-1,M_A)
         IF (.NOT.(M_D == MFMV2(J))) THEN
             CALL ERRPRT_FM('BES_YN',M_A,'M_A',MFMV2(J),'M_C',M_D,'M_D')
         ENDIF
      ENDDO

      NCASE = 2058
      M_A = TO_FM('45.76313747902851151016887592625714022')
      MFMV2 = BESSEL_YN(5,7,M_A)
      DO J = 1, 3
         M_D = BESSEL_Y(J+4,M_A)
         IF (.NOT.(M_D == MFMV2(J))) THEN
             CALL ERRPRT_FM('BES_YN',M_A,'M_A',MFMV2(J),'M_C',M_D,'M_D')
         ENDIF
      ENDDO

      NCASE = 2059
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPC(MP1,MP4)
      CALL FPST2M('0.70093080766765024647108053129311787400047652090339761',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2060
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
      CALL FPC(MP1,MP4)
      CALL FPST2M('0.50039725503716926991543653820001681893864568953849831',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2061
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_C(M_A,M_C)
      M_D = TO_FM('0.474185047305100802036571447978041504166048152999958048195')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' C    ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2062
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = FRESNEL_C(M_A)
      M_D = TO_FM('0.323694749294869464549126969706085301507654288830977216874')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' C    ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2063
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = FRESNEL_C(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == FRESNEL_C(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2064
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = FRESNEL_C(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == FRESNEL_C(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2065
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPCI(MP1,MP4)
      CALL FPST2M('0.16359653190526440803969970201664214390677012794223332',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2066
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
      CALL FPCI(MP1,MP4)
      CALL FPST2M('0.00131149972931578659459371814940608018872333303675684',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2067
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_CI(M_A,M_C)
      M_D = TO_FM('-0.09741800567259753506641387590335440898467110400622055004')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' CI   ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2068
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = COS_INTEGRAL(M_A)
      M_D = TO_FM('0.461138635729125521212988221957593798317545122640768597596')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' CI   ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2069
      MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
      MFMV2 = COS_INTEGRAL(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == COS_INTEGRAL(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2070
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = COS_INTEGRAL(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == COS_INTEGRAL(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2071
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPCHI(MP1,MP4)
      CALL FPST2M('0.45391567917918361783871059919514892434083540938287730',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2072
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
      CALL FPCHI(MP1,MP4)
      CALL FPST2M('4.97524761172698478085053978815976047476478376994146601603E+327',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2073
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_CHI(M_A,M_C)
      M_D = TO_FM('8.369873724415932287335807611146084488445255497226133667162')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' CHI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2074
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = COSH_INTEGRAL(M_A)
      M_D = TO_FM('2.029389481780475855055661101690384319730636141596070218552')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' CHI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2075
      MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
      MFMV2 = COSH_INTEGRAL(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == COSH_INTEGRAL(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2076
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = COSH_INTEGRAL(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == COSH_INTEGRAL(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2077
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPEI(MP1,MP4)
      CALL FPST2M('1.24079391564823418645696678687520762323754599014641389',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2078
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
      CALL FPEI(MP1,MP4)
      CALL FPST2M('9.95049522345396956170107957631952094952956753988293203207e327',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2079
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('-76.187741826338453069315950161768197166176197016819716',MP1)
      CALL FPEI(MP1,MP4)
      CALL FPST2M('-1.0582953867286369384402649747001954422153942812201779081e-35',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2080
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_EI(M_A,M_C)
      M_D = TO_FM('16.74474823903927976564480561675304621451626105015241561691')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' EI   ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2081
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = EXP_INTEGRAL_EI(M_A)
      M_D = TO_FM('4.126976466117941107497767353354627810661198867641799416837')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' EI   ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2082
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = EXP_INTEGRAL_EI(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == EXP_INTEGRAL_EI(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2083
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = EXP_INTEGRAL_EI(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == EXP_INTEGRAL_EI(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2084
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPEN(2,MP1,MP4)
      CALL FPST2M('0.21311259166852101417208662675364586968103289659979351',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2085
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_EN(1,M_A,M_C)
      M_D = TO_FM('0.005000790207415190973190394460877237625750055700148282582')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' EN   ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2086
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = EXP_INTEGRAL_EN(2,M_A)
      M_D = TO_FM('0.051264349837010471403529969401060258628812446447171003753')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' EN   ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2087
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPERF(MP1,MP4)
      CALL FPST2M('0.71872401755779946235619478212012889850923788333405962',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2088
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_ERF(M_A,M_C)
      M_D = TO_FM('0.999999902573705653018913609266972468861889295927486074244')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' ERF  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2089
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = ERF(M_A)
      M_D = TO_FM('0.987349264543733922694659969705283287445319385344849039875')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' ERF  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2090
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = ERF(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ERF(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2091
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = ERF(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ERF(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2092
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPERFC(MP1,MP4)
      CALL FPST2M('0.28127598244220053764380521787987110149076211666594038',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2093
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_ERFC(M_A,M_C)
      M_D = TO_FM('9.742629434698108639073302753113811070407251392575621797281293e-8')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' ERFC ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2094
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = ERFC(M_A)
      M_D = TO_FM('0.012650735456266077305340030294716712554680614655150960125')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' ERFC ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2095
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = ERFC(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ERFC(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2096
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = ERFC(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ERFC(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2097
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPLERC(MP1,MP4)
      CALL FPST2M('-1.2684189477137498562516625540971134601277248866639213',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2098
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.76187741826338453069315950161768197166176197016819e166',MP1)
      CALL FPLERC(MP1,MP4)
      CALL FPST2M('-5.80457200459680176440663633717748607007309664599M+331',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-47 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2099
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('7618.77418263384530693159501617681971661761970168197166',MP1)
      CALL FPLERC(MP1,MP4)
      CALL FPST2M('-5.80457295567037365018902816623993644716703242747682e7',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2100
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_LERC(M_A,M_C)
      M_D = TO_FM('-16.1441697002365667213529634391734146510026147989134315461')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' LERC ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2101
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = LOG_ERFC(M_A)
      M_D = TO_FM('-4.37003992666334136276330328324363949591706428743873191723')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' LERC ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2102
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = LOG_ERFC(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == LOG_ERFC(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2103
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = LOG_ERFC(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == LOG_ERFC(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2104
      M_A = TO_FM('22.3')
      M_C = ERFC_SCALED(M_A)
      M_D = TO_FM('0.0252746198169048451531557506211538386878558334721659442813097')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('ERFC_S',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2105
      M_A = TO_FM('22.3')
      CALL FM_ERFC_SCALED(M_A,M_C)
      M_D = TO_FM('0.0252746198169048451531557506211538386878558334721659442813097')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM('ERFC_S',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2106
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('22.3',MP1)
      CALL FPERFCS(MP1,MP4)
      CALL FPST2M('0.0252746198169048451531557506211538386878558334721659442813097',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2107
      MFMV1 = TO_FM( (/ 12.1123456789D0, 34.2123456789D0, 56.3123456789D0 /) )
      MFMV2 = ERFC_SCALED(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == ERFC_SCALED(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2108
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = 31 + TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = ERFC_SCALED(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == ERFC_SCALED(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2109
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPLI(MP1,MP4)
      CALL FPST2M('-0.9793900433217607572331466402453083681659945255591914',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2110
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_LI(M_A,M_C)
      M_D = TO_FM('2.797997089943573501800184831901782240262866606296541185584')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' LI   ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2111
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = LOG_INTEGRAL(M_A)
      M_D = TO_FM('0.668796391754850708354080921181694708542231838607797144120')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' LI   ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2112
      MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
      MFMV2 = LOG_INTEGRAL(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == LOG_INTEGRAL(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2113
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = LOG_INTEGRAL(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == LOG_INTEGRAL(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2114
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPS(MP1,MP4)
      CALL FPST2M('0.21816325134409825621860357629665121608937929116536471',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2115
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
      CALL FPS(MP1,MP4)
      CALL FPST2M('0.50012939294593301301098168046160096978366608125882900',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2116
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_S(M_A,M_C)
      M_D = TO_FM('0.580281902413501913366950218788087272320285927001746179124')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' S    ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2117
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = FRESNEL_S(M_A)
      M_D = TO_FM('0.486368483997269340556953893768418549490362828623678106725')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' S    ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2118
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = FRESNEL_S(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == FRESNEL_S(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2119
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = FRESNEL_S(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == FRESNEL_S(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2120
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPSI(MP1,MP4)
      CALL FPST2M('0.73773231897820644930684330520081942495672326643513847',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2121
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
      CALL FPSI(MP1,MP4)
      CALL FPST2M('1.57084866664732825971020846026968465003368780298508651',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2122
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_SI(M_A,M_C)
      M_D = TO_FM('1.798158893955183419022680508529636904015624233443431352508')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' SI   ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2123
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = SIN_INTEGRAL(M_A)
      M_D = TO_FM('1.485583783707077764617204020897763202398558637245905748694')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' SI   ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2124
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = SIN_INTEGRAL(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == SIN_INTEGRAL(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2125
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = SIN_INTEGRAL(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == SIN_INTEGRAL(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2126
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
      CALL FPSHI(MP1,MP4)
      CALL FPST2M('0.78687823646905056861825618768005869889671058076353659',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2127
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
      CALL FPSHI(MP1,MP4)
      CALL FPST2M('4.97524761172698478085053978815976047476478376994146601603E+327',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-49 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2128
      M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
      CALL FM_SHI(M_A,M_C)
      M_D = TO_FM('8.374874514623347478308998005606961726071005552926281949744')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' SHI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2129
      M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
      M_C = SINH_INTEGRAL(M_A)
      M_D = TO_FM('2.097586984337465252442106251664243490930562726045729198285')
      M_D = ABS((M_C - M_D)/M_D)
      IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
          CALL ERRPRT_FM(' SHI  ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
      ENDIF

      NCASE = 2130
      MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
      MFMV2 = SINH_INTEGRAL(MFMV1)
      DO J = 1, 3
         IF (.NOT.(MFMV2(J) == SINH_INTEGRAL(MFMV1(J)))) THEN
             CALL PRTERR(KW)
             EXIT
         ENDIF
      ENDDO

      NCASE = 2131
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
         ENDDO
      ENDDO
      MFMB = SINH_INTEGRAL(MFMA)
      DO J = 1, 3
         DO K = 1, 3
            IF (.NOT.(MFMB(J,K) == SINH_INTEGRAL(MFMA(J,K)))) THEN
                CALL PRTERR(KW)
                EXIT
            ENDIF
         ENDDO
      ENDDO

      NCASE = 2132
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('7.418263384530693159501617681971661761970168197166e+99',MP1)
      CALL FPST2M('6.8259710208460269684650033687802985086166176197016819',MP2)
      CALL FPBETA(MP1,MP2,MP4)
      CALL FPST2M('1.01162064582829378146463715877011489612774362551e-679',MP3)
      CALL FPSUB(MP4,MP3,MP2)
      CALL FPDIV(MP2,MP3,MP5)
      CALL FPABS(MP5,MP4)
      CALL FPST2M(' 1.0E-45 ',MP3)
      IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2133
      WRITE (22,*) ' '
      WRITE (22,*) ' NCASE = ',NCASE
      WRITE (22,*) ' '
      CALL FPST2M('7.418263384530693159501617681971661761970168197166e+99',MP1)
      CALL FPGAM(MP1,MP4)
      IF (.NOT.(MWK(START(MP4)+2) == MEXPOV)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST61

      SUBROUTINE TEST62

!  Test type (FM) array equal assignments.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing derived-type array operations.')")

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')
      CALL FMSETVAR(' NTRACE = 0 ')

      NCASE = 2134
      MFMV1 = 123
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - 123)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2135
      MFMV1 = 123.45
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - 123.45)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2136
      MFMV1 = 123.456789D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - 123.456789D0)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2137
      MFMV1 = (123.67 , 987.65 )
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - 123.67)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2138
      MFMV1 = (123.987654D0 , 987.123456D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - 123.987654D0)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2139
      MFM3 = TO_FM('234.56')
      JV = MFM3
      J5 = 0
      DO J = 1, 3
         J5 = J5 + ABS(JV(J) - 234)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2140
      MFM3 = TO_FM('234.56')
      RV = MFM3
      R5 = 0
      DO J = 1, 3
         R5 = R5 + ABS(RV(J) - 234.56)
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2141
      MFM3 = TO_FM('234.56789')
      DV = MFM3
      D5 = 0
      DO J = 1, 3
         D5 = D5 + ABS(DV(J) - 234.56789D0)
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2142
      MFM3 = TO_FM('234.56')
      CV = MFM3
      R5 = 0
      DO J = 1, 3
         R5 = R5 + ABS(CV(J) - 234.56)
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2143
      MFM3 = TO_FM('234.56789')
      CDV = MFM3
      D5 = 0
      DO J = 1, 3
         D5 = D5 + ABS(CDV(J) - 234.56789D0)
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2144
      MFM3 = TO_FM('1234.56789')
      MFMV1 = MFM3
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - TO_FM('1234.56789'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2145
      MIM1 = TO_IM('123456789012345')
      MFMV1 = MIM1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - TO_FM('123456789012345'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2146
      MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
      MFMV1 = MZM1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - TO_FM('1234567.89012345'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2147
      MFM3 = TO_FM('1234.56789')
      MIMV1 = MFM3
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - TO_FM('1234'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2148
      MFM3 = TO_FM('1234.56789')
      MZMV1 = MFM3
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - TO_FM('1234.56789'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2149
      JV = (/ 12, -34, 56 /)
      MFMV1 = JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - JV(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2150
      RV = (/ 12.1, -34.2, 56.3 /)
      MFMV1 = RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - RV(J))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2151
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFMV1 = DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - DV(J))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2152
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFMV1 = CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - REAL(CV(J)))
      ENDDO
      MFM4 = RSMALL*84*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2153
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFMV1 = CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - REAL(CDV(J),KIND(0.0D0)))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2154
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      JV = MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(JV(J) - INT(MFMV1(J)))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2155
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      RV = MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(RV(J) - MFMV1(J))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2156
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      DV = MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(DV(J) - MFMV1(J))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2157
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      CV = MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(CV(J) - MFMV1(J))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2158
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      CDV = MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(CDV(J) - MFMV1(J))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2159
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV1 = MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - MFMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2160
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV1 = MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(REAL(MZMV1(J)) - MFMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST62

      SUBROUTINE TEST63

!  Test type (IM) array equal assignments.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2161
      MIMV1 = 123
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV1(J) - 123)
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2162
      MIMV1 = 123.45
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - 123)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2163
      MIMV1 = 123.456789D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - 123)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2164
      MIMV1 = (124.67 , 987.65 )
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - 124)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2165
      MIMV1 = (125.987654D0 , 987.123456D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - 125)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2166
      MIM1 = TO_FM('234.56')
      JV = MIM1
      J5 = 0
      DO J = 1, 3
         J5 = J5 + ABS(JV(J) - 234)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2167
      MIM1 = TO_FM('234.56')
      RV = MIM1
      R5 = 0
      DO J = 1, 3
         R5 = R5 + ABS(RV(J) - 234)
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2168
      MIM1 = TO_FM('234.56789')
      DV = MIM1
      D5 = 0
      DO J = 1, 3
         D5 = D5 + ABS(DV(J) - 234)
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2169
      MIM1 = TO_FM('234.56')
      CV = MIM1
      R5 = 0
      DO J = 1, 3
         R5 = R5 + ABS(CV(J) - 234)
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2170
      MIM1 = TO_FM('234.56789')
      CDV = MIM1
      D5 = 0
      DO J = 1, 3
         D5 = D5 + ABS(CDV(J) - 234)
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2171
      MIM1 = TO_FM('1234.56789')
      MIMV1 = MIM1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - 1234)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2172
      MIM1 = TO_IM('123456789012345')
      MIMV1 = MIM1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - TO_FM('123456789012345'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2173
      MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
      MIMV1 = MZM1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - TO_FM('1234567'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2174
      MIM1 = TO_FM('1234.56789')
      MZMV1 = MIM1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - TO_FM('1234'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2175
      JV = (/ 12, -34, 56 /)
      MIMV1 = JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - JV(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2176
      RV = (/ 12.1, -34.2, 56.3 /)
      MIMV1 = RV
      MFM3 = 0
      JV = RV
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - JV(J))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2177
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIMV1 = DV
      MFM3 = 0
      JV = DV
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - JV(J))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2178
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIMV1 = CV
      MFM3 = 0
      JV = CV
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - JV(J))
      ENDDO
      MFM4 = RSMALL*84*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2179
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIMV1 = CDV
      MFM3 = 0
      JV = CDV
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - JV(J))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2180
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      JV = MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(JV(J) - INT(MIMV1(J)))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2181
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      RV = MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(RV(J) - MIMV1(J))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2182
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      DV = MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(DV(J) - MIMV1(J))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2183
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      CV = MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(CV(J) - MIMV1(J))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2184
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      CDV = MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(CDV(J) - MIMV1(J))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2185
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIMV1 = MZMV1
      MFM3 = 0
      JV = (/ 12, -34, 56 /)
      DO J = 1, 3
         MFM3 = MFM3 + ABS(JV(J) - MIMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST63

      SUBROUTINE TEST64

!  Test type (ZM) array equal assignments.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2186
      MZMV1 = 123
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - 123)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2187
      MZMV1 = 123.45
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - 123.45)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2188
      MZMV1 = 123.456789D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - 123.456789D0)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2189
      MZMV1 = (123.67 , 987.65 )
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - (123.67 , 987.65 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2190
      MZMV1 = (123.987654D0 , 987.123456D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - (123.987654D0 , 987.123456D0))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2191
      MZM1 = TO_ZM('234.56 - 65.32 i')
      JV = MZM1
      J5 = 0
      DO J = 1, 3
         J5 = J5 + ABS(JV(J) - 234)
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2192
      MZM1 = TO_ZM('234.56 - 65.32 i')
      RV = MZM1
      R5 = 0
      DO J = 1, 3
         R5 = R5 + ABS(RV(J) - 234.56)
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2193
      MZM1 = TO_ZM('234.56789 - 765.765432 i')
      DV = MZM1
      D5 = 0
      DO J = 1, 3
         D5 = D5 + ABS(DV(J) - 234.56789D0)
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2194
      MZM1 = TO_ZM('234.56 - 65.32 i')
      CV = MZM1
      R5 = 0
      DO J = 1, 3
         R5 = R5 + ABS(CV(J) - MZM1)
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2195
      MZM1 = TO_ZM('234.56789 - 765.765432 i')
      CDV = MZM1
      D5 = 0
      DO J = 1, 3
         D5 = D5 + ABS(CDV(J) - MZM1)
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2196
      MZM1 = TO_ZM('1234.56789 - 4.374659586')
      MFMV1 = MZM1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - TO_FM('1234.56789'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2197
      MIM1 = TO_IM('123456789012345')
      MZMV1 = MIM1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - TO_FM('123456789012345'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2198
      MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
      MZMV1 = MZM1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - TO_ZM('1234567.89012345 - 31.654 i'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2199
      MZM1 = TO_ZM('1234.56789 - 4.374659586')
      MIMV1 = MZM1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - TO_FM('1234'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2200
      MZM1 = TO_ZM('1234.56789 - 4.374659586')
      MZMV1 = MZM1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - TO_ZM('1234.56789 - 4.374659586'))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2201
      JV = (/ 12, -34, 56 /)
      MZMV1 = JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - JV(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2202
      RV = (/ 12.1, -34.2, 56.3 /)
      MZMV1 = RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - RV(J))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2203
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZMV1 = DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - DV(J))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2204
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZMV1 = CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - CV(J))
      ENDDO
      MFM4 = RSMALL*84*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2205
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZMV1 = CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV1(J) - CDV(J))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2206
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      JV = MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(JV(J) - REAL(INT(MZMV1(J))))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2207
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      RV = MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(RV(J) - REAL(MZMV1(J)))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2208
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      DV = MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(DV(J) - REAL(MZMV1(J)))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2209
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      CV = MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(CV(J) - MZMV1(J))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2210
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      CDV = MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(CDV(J) - MZMV1(J))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2211
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV1 = MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV1(J) - MZMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2212
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV1 = MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV1(J) - MZMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2213
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - MZMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST64

      SUBROUTINE TEST65

!  Test type (FM) array equal assignments.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')
      CALL FMSETVAR(' NTRACE = 0 ')

      NCASE = 2214
      MFMA = 123
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - 123)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2215
      MFMA = 123.45
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - 123.45)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2216
      MFMA = 123.456789D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - 123.456789D0)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2217
      MFMA = (123.67 , 987.65 )
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - 123.67)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2218
      MFMA = (123.987654D0 , 987.123456D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - 123.987654D0)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2219
      MFM3 = TO_FM('234.56')
      JV2 = MFM3
      J5 = 0
      DO J = 1, 3
         DO K = 1, 3
            J5 = J5 + ABS(JV2(J,K) - 234)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2220
      MFM3 = TO_FM('234.56')
      RV2 = MFM3
      R5 = 0
      DO J = 1, 3
         DO K = 1, 3
            R5 = R5 + ABS(RV2(J,K) - 234.56)
         ENDDO
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2221
      MFM3 = TO_FM('234.56789')
      DV2 = MFM3
      D5 = 0
      DO J = 1, 3
         DO K = 1, 3
            D5 = D5 + ABS(DV2(J,K) - 234.56789D0)
         ENDDO
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2222
      MFM3 = TO_FM('234.56')
      CV2 = MFM3
      R5 = 0
      DO J = 1, 3
         DO K = 1, 3
            R5 = R5 + ABS(CV2(J,K) - 234.56)
         ENDDO
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2223
      MFM3 = TO_FM('234.56789')
      CDV2 = MFM3
      D5 = 0
      DO J = 1, 3
         DO K = 1, 3
            D5 = D5 + ABS(CDV2(J,K) - 234.56789D0)
         ENDDO
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2224
      MFM3 = TO_FM('1234.56789')
      MFMA = MFM3
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - TO_FM('1234.56789'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2225
      MIM1 = TO_IM('123456789012345')
      MFMA = MIM1
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - TO_FM('123456789012345'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2226
      MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
      MFMA = MZM1
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - TO_FM('1234567.89012345'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2227
      MFM3 = TO_FM('1234.56789')
      MIMA2 = MFM3
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - TO_FM('1234'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2228
      MFM3 = TO_FM('1234.56789')
      MZMA2 = MFM3
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - TO_FM('1234.56789'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2229
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFMA = JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - JV2(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2230
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFMA = RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - RV2(J,K))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2231
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFMA = DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - DV2(J,K))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2232
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFMA = CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - REAL(CV2(J,K)))
         ENDDO
      ENDDO
      MFM4 = RSMALL*84*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2233
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFMA = CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - REAL(CDV2(J,K),KIND(0.0D0)))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2234
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      JV2 = MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(JV2(J,K) - INT(MFMA(J,K)))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2235
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      RV2 = MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(RV2(J,K) - MFMA(J,K))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2236
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DV2 = MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(DV2(J,K) - MFMA(J,K))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2237
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      CV2 = MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(CV2(J,K) - MFMA(J,K))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2238
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      CDV2 = MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(CDV2(J,K) - MFMA(J,K))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2239
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMA = MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - MFMA(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2240
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFMA = MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(REAL(MZMA2(J,K)) - MFMA(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST65

      SUBROUTINE TEST66

!  Test type (IM) array equal assignments.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2241
      MIMA2 = 123
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMA2(J,K) - 123)
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2242
      MIMA2 = 123.45
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - 123)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2243
      MIMA2 = 123.456789D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - 123)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2244
      MIMA2 = (124.67 , 987.65 )
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - 124)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2245
      MIMA2 = (125.987654D0 , 987.123456D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - 125)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2246
      MIM1 = TO_FM('234.56')
      JV2 = MIM1
      J5 = 0
      DO J = 1, 3
         DO K = 1, 3
            J5 = J5 + ABS(JV2(J,K) - 234)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2247
      MIM1 = TO_FM('234.56')
      RV2 = MIM1
      R5 = 0
      DO J = 1, 3
         DO K = 1, 3
            R5 = R5 + ABS(RV2(J,K) - 234)
         ENDDO
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2248
      MIM1 = TO_FM('234.56789')
      DV2 = MIM1
      D5 = 0
      DO J = 1, 3
         DO K = 1, 3
            D5 = D5 + ABS(DV2(J,K) - 234)
         ENDDO
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2249
      MIM1 = TO_FM('234.56')
      CV2 = MIM1
      R5 = 0
      DO J = 1, 3
         DO K = 1, 3
            R5 = R5 + ABS(CV2(J,K) - 234)
         ENDDO
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2250
      MIM1 = TO_FM('234.56789')
      CDV2 = MIM1
      D5 = 0
      DO J = 1, 3
         DO K = 1, 3
            D5 = D5 + ABS(CDV2(J,K) - 234)
         ENDDO
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2251
      MIM1 = TO_FM('1234.56789')
      MIMA2 = MIM1
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - 1234)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2252
      MIM1 = TO_IM('123456789012345')
      MIMA2 = MIM1
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - TO_FM('123456789012345'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2253
      MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
      MIMA2 = MZM1
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - TO_FM('1234567'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2254
      MIM1 = TO_FM('1234.56789')
      MZMA2 = MIM1
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - TO_FM('1234'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2255
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIMA2 = JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - JV2(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2256
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIMA2 = RV2
      MFM3 = 0
      JV2 = RV2
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - JV2(J,K))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2257
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIMA2 = DV2
      MFM3 = 0
      JV2 = DV2
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - JV2(J,K))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2258
      DO J = 1, 3
         DO K = 1, 3
            CV2(J,K) = CMPLX(12.3+3*(J+3*(K-1)),-32.4+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIMA2 = CV2
      MFM3 = 0
      JV2 = CV2
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - JV2(J,K))
         ENDDO
      ENDDO
      MFM4 = RSMALL*84*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2259
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIMA2 = CDV2
      MFM3 = 0
      JV2 = CDV2
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - JV2(J,K))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2260
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      JV2 = MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(JV2(J,K) - INT(MIMA2(J,K)))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2261
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      RV2 = MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(RV2(J,K) - MIMA2(J,K))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2262
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DV2 = MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(DV2(J,K) - MIMA2(J,K))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2263
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      CV2 = MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(CV2(J,K) - MIMA2(J,K))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2264
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      CDV2 = MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(CDV2(J,K) - MIMA2(J,K))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2265
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIMA2 = MZMA2
      MFM3 = 0
      JV2 = RESHAPE( (/(62.3+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(JV2(J,K) - MIMA2(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST66

      END MODULE TEST_D


      MODULE TEST_E
      USE TEST_VARS

      CONTAINS

      SUBROUTINE TEST67

!  Test type (ZM) array equal assignments.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2266
      MZMA2 = 123
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - 123)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2267
      MZMA2 = 123.45
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - 123.45)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2268
      MZMA2 = 123.456789D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - 123.456789D0)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2269
      MZMA2 = (123.67 , 987.65 )
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - (123.67 , 987.65 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2270
      MZMA2 = (123.987654D0 , 987.123456D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - (123.987654D0 , 987.123456D0))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2271
      MZM1 = TO_ZM('234.56 - 65.32 i')
      JV2 = MZM1
      J5 = 0
      DO J = 1, 3
         DO K = 1, 3
            J5 = J5 + ABS(JV2(J,K) - 234)
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2272
      MZM1 = TO_ZM('234.56 - 65.32 i')
      RV2 = MZM1
      R5 = 0
      DO J = 1, 3
         DO K = 1, 3
            R5 = R5 + ABS(RV2(J,K) - 234.56)
         ENDDO
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2273
      MZM1 = TO_ZM('234.56789 - 765.765432 i')
      DV2 = MZM1
      D5 = 0
      DO J = 1, 3
         DO K = 1, 3
            D5 = D5 + ABS(DV2(J,K) - 234.56789D0)
         ENDDO
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2274
      MZM1 = TO_ZM('234.56 - 65.32 i')
      CV2 = MZM1
      R5 = 0
      DO J = 1, 3
         DO K = 1, 3
            R5 = R5 + ABS(CV2(J,K) - MZM1)
         ENDDO
      ENDDO
      MFM4 = RSMALL*234
      IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2275
      MZM1 = TO_ZM('234.56789 - 765.765432 i')
      CDV2 = MZM1
      D5 = 0
      DO J = 1, 3
         DO K = 1, 3
            D5 = D5 + ABS(CDV2(J,K) - MZM1)
         ENDDO
      ENDDO
      MFM4 = DSMALL*234
      IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2276
      MZM1 = TO_ZM('1234.56789 - 4.374659586')
      MFMA = MZM1
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - TO_FM('1234.56789'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2277
      MIM1 = TO_IM('123456789012345')
      MZMA2 = MIM1
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - TO_FM('123456789012345'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2278
      MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
      MZMA2 = MZM1
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - TO_ZM('1234567.89012345 - 31.654 i'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2279
      MZM1 = TO_ZM('1234.56789 - 4.374659586')
      MIMA2 = MZM1
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - TO_FM('1234'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2280
      MZM1 = TO_ZM('1234.56789 - 4.374659586')
      MZMA2 = MZM1
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - TO_ZM('1234.56789 - 4.374659586'))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2281
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZMA2 = JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - JV2(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2282
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZMA2 = RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - RV2(J,K))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2283
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZMA2 = DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - DV2(J,K))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2284
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZMA2 = CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - CV2(J,K))
         ENDDO
      ENDDO
      MFM4 = RSMALL*84*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2285
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZMA2 = CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA2(J,K) - CDV2(J,K))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2286
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      JV2 = MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(JV2(J,K) - REAL(INT(MZMA2(J,K))))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2287
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      RV2 = MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(RV2(J,K) - REAL(MZMA2(J,K)))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2288
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DV2 = MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(DV2(J,K) - REAL(MZMA2(J,K)))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2289
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      CV2 = MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(CV2(J,K) - MZMA2(J,K))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2290
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      CDV2 = MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(CDV2(J,K) - MZMA2(J,K))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2291
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMA2 = MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMA(J,K) - MZMA2(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2292
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMA2 = MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMA2(J,K) - MZMA2(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2293
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMA3 = MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMA3(J,K) - MZMA2(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST67

      SUBROUTINE TEST68

!  Test type (FM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2294
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4 + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4 + MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2295
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4.8 + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.8 + MFMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2296
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4.87D0 + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.87D0 + MFMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2297
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.8,5.9) + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) + MFMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2298
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.87D0,5.98D0) + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) + MFMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2299
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 + 4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + 4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2300
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 + 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2301
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 + 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2302
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 + (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2303
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 + (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2304
      JV = (/ 12, -34, 56 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 + JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 + JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2305
      RV = (/ 12.1, -34.2, 56.3 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 + RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 + RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2306
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 + DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 + DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2307
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 + CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 + CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2308
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 + CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 + CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2309
      JV = (/ 12, -34, 56 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = JV + MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) + MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2310
      RV = (/ 12.1, -34.2, 56.3 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = RV + MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) + MFM4 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2311
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = DV + MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) + MFM4 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2312
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = CV + MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) + MFM4 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2313
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = CDV + MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MFM4 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2314
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 + MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2315
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFMV1 + MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2316
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_IM('121123456789')
      MFMV2 = MIM2 + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIM2 + MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2317
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_IM('121123456789')
      MFMV2 = MFMV1 + MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2318
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2319
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MFMV1 + MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2320
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 + MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2321
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MIMV1 + MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) + MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2322
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 + MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2323
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MZMV1 + MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST68

      SUBROUTINE TEST69

!  Test type (FM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2324
      JV = (/ 12, -34, 56 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = JV + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) + MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2325
      JV = (/ 12, -34, 56 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 + JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2326
      RV = (/ 12.1, -34.2, 56.3 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = RV + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) + MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2327
      RV = (/ 12.1, -34.2, 56.3 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 + RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2328
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = DV + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) + MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2329
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 + DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2330
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CV + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) + MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2331
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 + CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2332
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CDV + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2333
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 + CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2334
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
      MFMV2 = MFMV1 + MFMV4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + MFMV4(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2335
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MFMV2 = MFMV1 + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2336
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MFMV2 = MIMV1 + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) + MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2337
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MZMV1 + MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2338
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2339
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = +MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - MFMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2340
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MIMV2 = +MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - MIMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2341
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = +MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - MZMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2342
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = -MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) + MFMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2343
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MIMV2 = -MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) + MIMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2344
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = -MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) + MZMV1(J))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2345
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = +MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - MFMA(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2346
      DO J = 1, 2
         DO K = 1, 2
            MIMA(J,K) = TO_IM(257+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB = +MIMA
      MFM3 = 0
      DO J = 1, 2
         DO K = 1, 2
            MFM3 = MFM3 + ABS(MIMB(J,K) - MIMA(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2347
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = +MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - MZMA2(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2348
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = -MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) + MFMA(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2349
      DO J = 1, 2
         DO K = 1, 2
            MIMA(J,K) = TO_IM(257+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB = -MIMA
      MFM3 = 0
      DO J = 1, 2
         DO K = 1, 2
            MFM3 = MFM3 + ABS(MIMB(J,K) + MIMA(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2350
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = -MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) + MZMA2(J,K))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST69

      SUBROUTINE TEST70

!  Test type (IM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2351
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MIMV2 = 4 + MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( 4 + MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2352
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = 4.8 + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.8 + MIMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2353
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = 4.87D0 + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.87D0 + MIMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2354
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.8,5.9) + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) + MIMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2355
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.87D0,5.98D0) + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) + MIMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2356
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 + 4
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) + 4 ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2357
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 + 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) + 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2358
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 + 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) + 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2359
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 + (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2360
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 + (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2361
      JV = (/ 12, -34, 56 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 + JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - ( MIM2 + JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2362
      RV = (/ 12.1, -34.2, 56.3 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 + RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 + RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2363
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 + DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 + DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2364
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 + CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 + CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2365
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 + CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 + CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2366
      JV = (/ 12, -34, 56 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = JV + MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - ( JV(J) + MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2367
      RV = (/ 12.1, -34.2, 56.3 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = RV + MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) + MIM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2368
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = DV + MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) + MIM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2369
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = CV + MIM2
      MFM3 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MZMV2(J) - ( CV(J) + MIM2 ))
      ENDDO
      MIM2 = RSMALL*56*3
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2370
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = CDV + MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MIM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2371
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 + MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIM2 + MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2372
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIMV1 + MIM2
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) + MIM2 ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2373
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2374
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MIMV1 + MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2375
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 + MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2376
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MZMV1 + MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST70

      SUBROUTINE TEST71

!  Test type (IM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2377
      JV = (/ 12, -34, 56 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = JV + MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( JV(J) + MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2378
      JV = (/ 12, -34, 56 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 + JV
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) + JV(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2379
      RV = (/ 12.1, -34.2, 56.3 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = RV + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) + MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2380
      RV = (/ 12.1, -34.2, 56.3 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 + RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) + RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2381
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = DV + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) + MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2382
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 + DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) + DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2383
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CV + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) + MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2384
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 + CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2385
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CDV + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2386
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 + CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2387
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
      MIMV2 = MIMV1 + MIMV4
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) + MIMV4(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2388
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MZMV1 + MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2389
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST71

      SUBROUTINE TEST72

!  Test type (ZM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2390
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4 + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4 + MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2391
      MFMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4.8 + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.8 + MZMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2392
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4.87D0 + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.87D0 + MZMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2393
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (4.8,5.9) + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) + MZMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2394
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (4.87D0,5.98D0) + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) + MZMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2395
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 + 4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + 4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2396
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 + 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2397
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 + 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2398
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 + (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2399
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 + (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2400
      JV = (/ 12, -34, 56 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 + JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2401
      RV = (/ 12.1, -34.2, 56.3 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 + RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2402
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 + DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2403
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 + CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2404
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 + CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2405
      JV = (/ 12, -34, 56 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = JV + MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) + MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2406
      RV = (/ 12.1, -34.2, 56.3 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = RV + MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) + MZM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2407
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = DV + MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) + MZM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2408
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = CV + MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) + MZM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2409
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = CDV + MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MZM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2410
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2411
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZMV1 + MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST72

      SUBROUTINE TEST73

!  Test type (ZM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2412
      JV = (/ 12, -34, 56 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = JV + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) + MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2413
      JV = (/ 12, -34, 56 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 + JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2414
      RV = (/ 12.1, -34.2, 56.3 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = RV + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) + MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2415
      RV = (/ 12.1, -34.2, 56.3 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 + RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2416
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = DV + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) + MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2417
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 + DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2418
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = CV + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) + MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2419
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 + CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2420
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = CDV + MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2421
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 + CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2422
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (/ TO_ZM('1.21123456789 + 0.9574635 i') , TO_ZM('-3.42123456789 - 0.54 i') ,  &
                 TO_ZM('5.63123456789 + 0.00345 i') /)
      MZMV4 = MZMV1 + MZMV2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV4(J) - ( MZMV1(J) + MZMV2(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST73

      SUBROUTINE TEST74

!  Test type (FM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2423
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4 + MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2424
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4.8 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.8 + MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2425
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4.87D0 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.87D0 + MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2426
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) + MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2427
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) + MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2428
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA + 4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + 4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2429
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA + 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2430
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA + 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2431
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA + (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2432
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA + (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2433
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 + JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 + JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2434
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 + RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 + RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2435
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 + DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 + DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2436
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 + CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 + CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2437
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 + CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 + CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2438
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = JV2 + MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) + MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2439
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = RV2 + MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) + MFM4 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2440
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = DV2 + MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) + MFM4 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2441
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = CV2 + MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) + MFM4 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2442
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = CDV2 + MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MFM4 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2443
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 + MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2444
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFMA + MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2445
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_IM('121123456789')
      MFMB = MIM2 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIM2 + MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2446
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_IM('121123456789')
      MFMB = MFMA + MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2447
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2448
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MFMA + MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2449
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 + MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2450
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MIMA2 + MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) + MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2451
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 + MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2452
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MZMA2 + MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST74

      SUBROUTINE TEST75

!  Test type (FM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2453
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = JV2 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) + MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2454
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA + JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2455
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = RV2 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) + MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2456
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA + RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2457
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = DV2 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) + MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2458
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA + DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2459
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CV2 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) + MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2460
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA + CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2461
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CDV2 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2462
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA + CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2463
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMC(J,K) = TO_FM(55+5*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA + MFMC
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + MFMC(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2464
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2465
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MIMA2 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) + MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2466
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2467
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST75

      SUBROUTINE TEST76

!  Test type (IM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2468
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 4 + MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( 4 + MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2469
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 4.8 + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.8 + MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2470
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 4.87D0 + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.87D0 + MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2471
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) + MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2472
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) + MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2473
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 + 4
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) + 4 ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2474
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 + 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) + 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2475
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 + 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) + 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2476
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 + (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2477
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 + (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2478
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 + JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - ( MIM2 + JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2479
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 + RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 + RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2480
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 + DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 + DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2481
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 + CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 + CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2482
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 + CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 + CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2483
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = JV2 + MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - ( JV2(J,K) + MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2484
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = RV2 + MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) + MIM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2485
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = DV2 + MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) + MIM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2486
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = CV2 + MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MZMB2(J,K) - ( CV2(J,K) + MIM2 ))
         ENDDO
      ENDDO
      MIM2 = RSMALL*56*3
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2487
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = CDV2 + MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MIM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2488
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 + MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIM2 + MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2489
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIMA2 + MIM2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) + MIM2 ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2490
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2491
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MIMA2 + MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2492
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 + MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2493
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MZMA2 + MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST76

      SUBROUTINE TEST77

!  Test type (IM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2494
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = JV2 + MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( JV2(J,K) + MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2495
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 + JV2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) + JV2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2496
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = RV2 + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) + MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2497
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 + RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) + RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2498
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = DV2 + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) + MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2499
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 + DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) + DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2500
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CV2 + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) + MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2501
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 + CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2502
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CDV2 + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2503
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 + CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2504
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMC2(J,K) = TO_FM(37+11*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 + MIMC2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) + MIMC2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2505
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2506
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST77

      SUBROUTINE TEST78

!  Test type (ZM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2507
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4 + MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2508
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4.8 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.8 + MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2509
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4.87D0 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.87D0 + MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2510
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) + MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2511
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) + MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2512
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + 4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + 4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2513
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2514
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2515
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2516
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2517
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 + JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2518
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 + RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2519
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 + DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2520
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 + CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2521
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 + CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2522
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = JV2 + MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) + MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2523
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = RV2 + MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) + MZM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2524
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = DV2 + MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) + MZM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2525
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = CV2 + MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) + MZM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2526
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = CDV2 + MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MZM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2527
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2528
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZMA2 + MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST78

      END MODULE TEST_E


      MODULE TEST_F
      USE TEST_VARS

      CONTAINS

      SUBROUTINE TEST79

!  Test type (ZM) array addition operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2529
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = JV2 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) + MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2530
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2531
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = RV2 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) + MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2532
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2533
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = DV2 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) + MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2534
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2535
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = CV2 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) + MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2536
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2537
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = CDV2 + MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2538
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 + CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2539
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MZMB2(J,K) = CMPLX(TO_FM(48.3+5*(J+3*(K-1))), TO_FM(-31.4+8*(J+3*(K-1))))
         ENDDO
      ENDDO
      MZMC2 = MZMA2 + MZMB2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMC2(J,K) - ( MZMA2(J,K) + MZMB2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST79

      SUBROUTINE TEST80

!  Test type (FM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2540
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4 - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4 - MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2541
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4.8 - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.8 - MFMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2542
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4.87D0 - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.87D0 - MFMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2543
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.8,5.9) - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) - MFMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2544
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.87D0,5.98D0) - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) - MFMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2545
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 - 4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - 4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2546
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 - 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2547
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 - 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2548
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 - (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2549
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 - (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2550
      JV = (/ 12, -34, 56 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 - JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 - JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2551
      RV = (/ 12.1, -34.2, 56.3 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 - RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 - RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2552
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 - DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 - DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2553
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 - CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 - CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2554
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 - CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 - CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2555
      JV = (/ 12, -34, 56 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = JV - MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) - MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2556
      RV = (/ 12.1, -34.2, 56.3 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = RV - MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) - MFM4 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2557
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = DV - MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) - MFM4 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2558
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = CV - MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) - MFM4 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2559
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = CDV - MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MFM4 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2560
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 - MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2561
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFMV1 - MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2562
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_IM('121123456789')
      MFMV2 = MIM2 - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIM2 - MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2563
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_IM('121123456789')
      MFMV2 = MFMV1 - MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2564
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2565
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MFMV1 - MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2566
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 - MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2567
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MIMV1 - MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) - MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2568
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 - MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2569
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MZMV1 - MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST80

      SUBROUTINE TEST81

!  Test type (FM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2570
      JV = (/ 12, -34, 56 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = JV - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) - MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2571
      JV = (/ 12, -34, 56 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 - JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2572
      RV = (/ 12.1, -34.2, 56.3 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = RV - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) - MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2573
      RV = (/ 12.1, -34.2, 56.3 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 - RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2574
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = DV - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) - MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2575
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 - DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2576
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CV - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) - MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2577
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 - CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2578
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CDV - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2579
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 - CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2580
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
      MFMV2 = MFMV1 - MFMV4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - MFMV4(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2581
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MFMV2 = MFMV1 - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2582
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MFMV2 = MIMV1 - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) - MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2583
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MZMV1 - MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2584
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST81

      SUBROUTINE TEST82

!  Test type (IM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2585
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MIMV2 = 4 - MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( 4 - MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2586
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = 4.8 - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.8 - MIMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2587
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = 4.87D0 - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.87D0 - MIMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2588
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.8,5.9) - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) - MIMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2589
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.87D0,5.98D0) - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) - MIMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2590
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 - 4
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) - 4 ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2591
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 - 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) - 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2592
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 - 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) - 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2593
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 - (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2594
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 - (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2595
      JV = (/ 12, -34, 56 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 - JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - ( MIM2 - JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2596
      RV = (/ 12.1, -34.2, 56.3 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 - RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 - RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2597
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 - DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 - DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2598
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 - CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 - CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2599
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 - CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 - CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2600
      JV = (/ 12, -34, 56 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = JV - MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - ( JV(J) - MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2601
      RV = (/ 12.1, -34.2, 56.3 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = RV - MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) - MIM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2602
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = DV - MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) - MIM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2603
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = CV - MIM2
      MFM3 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MZMV2(J) - ( CV(J) - MIM2 ))
      ENDDO
      MIM2 = RSMALL*56*3
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2604
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = CDV - MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MIM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2605
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 - MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIM2 - MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2606
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIMV1 - MIM2
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) - MIM2 ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2607
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2608
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MIMV1 - MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2609
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 - MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2610
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MZMV1 - MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST82

      SUBROUTINE TEST83

!  Test type (IM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2611
      JV = (/ 12, -34, 56 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = JV - MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( JV(J) - MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2612
      JV = (/ 12, -34, 56 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 - JV
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) - JV(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2613
      RV = (/ 12.1, -34.2, 56.3 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = RV - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) - MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2614
      RV = (/ 12.1, -34.2, 56.3 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 - RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) - RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2615
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = DV - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) - MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2616
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 - DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) - DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2617
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CV - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) - MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2618
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 - CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2619
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CDV - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2620
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 - CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2621
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
      MIMV2 = MIMV1 - MIMV4
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) - MIMV4(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2622
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MZMV1 - MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2623
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST83

      SUBROUTINE TEST84

!  Test type (ZM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2624
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4 - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4 - MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2625
      MFMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4.8 - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.8 - MZMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2626
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4.87D0 - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.87D0 - MZMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2627
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (4.8,5.9) - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) - MZMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2628
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (4.87D0,5.98D0) - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) - MZMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2629
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 - 4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - 4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2630
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 - 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2631
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 - 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2632
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 - (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2633
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 - (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2634
      JV = (/ 12, -34, 56 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 - JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2635
      RV = (/ 12.1, -34.2, 56.3 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 - RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2636
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 - DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2637
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 - CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2638
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 - CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2639
      JV = (/ 12, -34, 56 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = JV - MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) - MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2640
      RV = (/ 12.1, -34.2, 56.3 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = RV - MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) - MZM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2641
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = DV - MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) - MZM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2642
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = CV - MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) - MZM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2643
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = CDV - MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MZM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2644
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2645
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZMV1 - MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST84

      SUBROUTINE TEST85

!  Test type (ZM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2646
      JV = (/ 12, -34, 56 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = JV - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) - MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2647
      JV = (/ 12, -34, 56 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 - JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2648
      RV = (/ 12.1, -34.2, 56.3 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = RV - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) - MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2649
      RV = (/ 12.1, -34.2, 56.3 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 - RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2650
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = DV - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) - MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2651
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 - DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2652
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = CV - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) - MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2653
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 - CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2654
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = CDV - MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2655
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 - CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2656
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (/ TO_ZM('1.21123456789 + 0.9574635 i') , TO_ZM('-3.42123456789 - 0.54 i') ,  &
                 TO_ZM('5.63123456789 + 0.00345 i') /)
      MZMV4 = MZMV1 - MZMV2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV4(J) - ( MZMV1(J) - MZMV2(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST85

      SUBROUTINE TEST86

!  Test type (FM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2657
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4 - MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2658
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4.8 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.8 - MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2659
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4.87D0 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.87D0 - MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2660
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) - MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2661
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) - MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2662
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA - 4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - 4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2663
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA - 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2664
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA - 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2665
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA - (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2666
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA - (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2667
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 - JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 - JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2668
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 - RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 - RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2669
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 - DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 - DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2670
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 - CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 - CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2671
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 - CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 - CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2672
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = JV2 - MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) - MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2673
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = RV2 - MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) - MFM4 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2674
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = DV2 - MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) - MFM4 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2675
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = CV2 - MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) - MFM4 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2676
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = CDV2 - MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MFM4 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2677
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 - MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2678
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFMA - MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2679
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_IM('121123456789')
      MFMB = MIM2 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIM2 - MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2680
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_IM('121123456789')
      MFMB = MFMA - MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2681
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2682
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MFMA - MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2683
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 - MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2684
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MIMA2 - MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) - MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2685
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 - MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2686
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MZMA2 - MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST86

      SUBROUTINE TEST87

!  Test type (FM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2687
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = JV2 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) - MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2688
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA - JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2689
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = RV2 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) - MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2690
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA - RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2691
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = DV2 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) - MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2692
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA - DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2693
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CV2 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) - MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2694
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA - CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2695
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CDV2 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2696
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA - CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2697
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMC(J,K) = TO_FM(55+5*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA - MFMC
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - MFMC(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2698
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2699
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MIMA2 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) - MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2700
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2701
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST87

      SUBROUTINE TEST88

!  Test type (IM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2702
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 4 - MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( 4 - MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2703
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 4.8 - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.8 - MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2704
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 4.87D0 - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.87D0 - MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2705
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) - MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2706
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) - MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2707
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 - 4
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) - 4 ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2708
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 - 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) - 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2709
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 - 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) - 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2710
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 - (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2711
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 - (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2712
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 - JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - ( MIM2 - JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2713
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 - RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 - RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2714
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 - DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 - DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2715
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 - CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 - CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2716
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 - CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 - CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2717
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = JV2 - MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - ( JV2(J,K) - MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2718
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = RV2 - MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) - MIM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2719
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = DV2 - MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) - MIM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2720
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = CV2 - MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MZMB2(J,K) - ( CV2(J,K) - MIM2 ))
         ENDDO
      ENDDO
      MIM2 = RSMALL*56*3
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2721
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = CDV2 - MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MIM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2722
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 - MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIM2 - MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2723
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIMA2 - MIM2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) - MIM2 ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2724
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2725
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MIMA2 - MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2726
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 - MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2727
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MZMA2 - MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST88

      SUBROUTINE TEST89

!  Test type (IM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2728
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = JV2 - MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( JV2(J,K) - MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2729
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 - JV2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) - JV2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2730
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = RV2 - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) - MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2731
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 - RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) - RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2732
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = DV2 - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) - MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2733
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 - DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) - DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2734
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CV2 - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) - MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2735
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 - CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2736
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CDV2 - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2737
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 - CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2738
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMC2(J,K) = TO_FM(37+11*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 - MIMC2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) - MIMC2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2739
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2740
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST89

      SUBROUTINE TEST90

!  Test type (ZM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2741
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4 - MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2742
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4.8 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.8 - MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2743
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4.87D0 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.87D0 - MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2744
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) - MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2745
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) - MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2746
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - 4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - 4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2747
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2748
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2749
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2750
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2751
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 - JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2752
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 - RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2753
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 - DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2754
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 - CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2755
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 - CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2756
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = JV2 - MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) - MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2757
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = RV2 - MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) - MZM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2758
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = DV2 - MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) - MZM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2759
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = CV2 - MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) - MZM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2760
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = CDV2 - MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MZM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2761
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2762
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZMA2 - MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST90

      END MODULE TEST_F


      MODULE TEST_G
      USE TEST_VARS

      CONTAINS

      SUBROUTINE TEST91

!  Test type (ZM) array subtraction operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2763
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = JV2 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) - MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2764
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2765
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = RV2 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) - MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2766
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2767
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = DV2 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) - MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2768
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2769
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = CV2 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) - MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2770
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2771
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = CDV2 - MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2772
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 - CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2773
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MZMB2(J,K) = CMPLX(TO_FM(48.3+5*(J+3*(K-1))), TO_FM(-31.4+8*(J+3*(K-1))))
         ENDDO
      ENDDO
      MZMC2 = MZMA2 - MZMB2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMC2(J,K) - ( MZMA2(J,K) - MZMB2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST91

      SUBROUTINE TEST92

!  Test type (FM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2774
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4 * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4 * MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2775
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4.8 * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.8 * MFMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2776
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4.87D0 * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.87D0 * MFMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2777
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.8,5.9) * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) * MFMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2778
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.87D0,5.98D0) * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) * MFMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2779
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 * 4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * 4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2780
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 * 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2781
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 * 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2782
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 * (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2783
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 * (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2784
      JV = (/ 12, -34, 56 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 * JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 * JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2785
      RV = (/ 12.1, -34.2, 56.3 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 * RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 * RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2786
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 * DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 * DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2787
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 * CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 * CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2788
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 * CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 * CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2789
      JV = (/ 12, -34, 56 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = JV * MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) * MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2790
      RV = (/ 12.1, -34.2, 56.3 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = RV * MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) * MFM4 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2791
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = DV * MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) * MFM4 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2792
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = CV * MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) * MFM4 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2793
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = CDV * MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MFM4 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2794
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 * MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2795
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFMV1 * MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2796
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_IM('121123456789')
      MFMV2 = MIM2 * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIM2 * MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2797
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_IM('121123456789')
      MFMV2 = MFMV1 * MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2798
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2799
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MFMV1 * MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2800
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 * MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2801
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MIMV1 * MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) * MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2802
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 * MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2803
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MZMV1 * MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST92

      SUBROUTINE TEST93

!  Test type (FM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2804
      JV = (/ 12, -34, 56 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = JV * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) * MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2805
      JV = (/ 12, -34, 56 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 * JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2806
      RV = (/ 12.1, -34.2, 56.3 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = RV * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) * MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2807
      RV = (/ 12.1, -34.2, 56.3 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 * RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2808
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = DV * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) * MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2809
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 * DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2810
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CV * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) * MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2811
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 * CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2812
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CDV * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2813
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 * CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2814
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
      MFMV2 = MFMV1 * MFMV4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * MFMV4(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2815
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MFMV2 = MFMV1 * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2816
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MFMV2 = MIMV1 * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) * MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2817
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MZMV1 * MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2818
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST93

      SUBROUTINE TEST94

!  Test type (IM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2819
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MIMV2 = 4 * MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( 4 * MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2820
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = 4.8 * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.8 * MIMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2821
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = 4.87D0 * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.87D0 * MIMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2822
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.8,5.9) * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) * MIMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2823
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.87D0,5.98D0) * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) * MIMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2824
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 * 4
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) * 4 ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2825
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 * 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) * 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2826
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 * 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) * 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2827
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 * (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2828
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 * (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2829
      JV = (/ 12, -34, 56 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 * JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - ( MIM2 * JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2830
      RV = (/ 12.1, -34.2, 56.3 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 * RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 * RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2831
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 * DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 * DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2832
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 * CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 * CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2833
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 * CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 * CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2834
      JV = (/ 12, -34, 56 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = JV * MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - ( JV(J) * MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2835
      RV = (/ 12.1, -34.2, 56.3 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = RV * MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) * MIM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2836
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = DV * MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) * MIM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2837
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = CV * MIM2
      MFM3 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MZMV2(J) - ( CV(J) * MIM2 ))
      ENDDO
      MIM2 = RSMALL*56*3
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2838
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = CDV * MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MIM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2839
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 * MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIM2 * MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2840
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIMV1 * MIM2
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) * MIM2 ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2841
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2842
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MIMV1 * MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2843
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 * MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2844
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MZMV1 * MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST94

      SUBROUTINE TEST95

!  Test type (IM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2845
      JV = (/ 12, -34, 56 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = JV * MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( JV(J) * MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2846
      JV = (/ 12, -34, 56 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 * JV
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) * JV(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2847
      RV = (/ 12.1, -34.2, 56.3 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = RV * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) * MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2848
      RV = (/ 12.1, -34.2, 56.3 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 * RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) * RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2849
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = DV * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) * MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2850
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 * DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) * DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2851
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CV * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) * MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2852
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 * CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2853
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CDV * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2854
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 * CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2855
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
      MIMV2 = MIMV1 * MIMV4
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) * MIMV4(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2856
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MZMV1 * MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2857
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST95

      SUBROUTINE TEST96

!  Test type (ZM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2858
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4 * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4 * MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2859
      MFMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4.8 * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.8 * MZMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2860
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4.87D0 * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.87D0 * MZMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2861
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (4.8,5.9) * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) * MZMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2862
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (4.87D0,5.98D0) * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) * MZMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2863
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 * 4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * 4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2864
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 * 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2865
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 * 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2866
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 * (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2867
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 * (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2868
      JV = (/ 12, -34, 56 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 * JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2869
      RV = (/ 12.1, -34.2, 56.3 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 * RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2870
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 * DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2871
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 * CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2872
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 * CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2873
      JV = (/ 12, -34, 56 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = JV * MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) * MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2874
      RV = (/ 12.1, -34.2, 56.3 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = RV * MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) * MZM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2875
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = DV * MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) * MZM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2876
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = CV * MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) * MZM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2877
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = CDV * MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MZM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2878
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2879
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZMV1 * MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST96

      SUBROUTINE TEST97

!  Test type (ZM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2880
      JV = (/ 12, -34, 56 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = JV * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) * MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2881
      JV = (/ 12, -34, 56 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 * JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2882
      RV = (/ 12.1, -34.2, 56.3 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = RV * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) * MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2883
      RV = (/ 12.1, -34.2, 56.3 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 * RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2884
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = DV * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) * MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2885
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 * DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2886
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = CV * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) * MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2887
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 * CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2888
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = CDV * MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2889
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 * CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2890
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (/ TO_ZM('1.21123456789 + 0.9574635 i') , TO_ZM('-3.42123456789 - 0.54 i') ,  &
                 TO_ZM('5.63123456789 + 0.00345 i') /)
      MZMV4 = MZMV1 * MZMV2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV4(J) - ( MZMV1(J) * MZMV2(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST97

      SUBROUTINE TEST98

!  Test type (FM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2891
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4 * MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2892
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4.8 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.8 * MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2893
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4.87D0 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.87D0 * MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2894
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) * MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2895
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) * MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2896
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA * 4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * 4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2897
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA * 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2898
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA * 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2899
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA * (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2900
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA * (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2901
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 * JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 * JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2902
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 * RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 * RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2903
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 * DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 * DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2904
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 * CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 * CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2905
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 * CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 * CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2906
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = JV2 * MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) * MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2907
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = RV2 * MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) * MFM4 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2908
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = DV2 * MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) * MFM4 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2909
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = CV2 * MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) * MFM4 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2910
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = CDV2 * MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MFM4 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2911
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 * MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2912
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFMA * MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2913
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_IM('121123456789')
      MFMB = MIM2 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIM2 * MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2914
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_IM('121123456789')
      MFMB = MFMA * MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2915
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2916
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MFMA * MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2917
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 * MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2918
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MIMA2 * MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) * MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2919
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 * MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2920
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MZMA2 * MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST98

      SUBROUTINE TEST99

!  Test type (FM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2921
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = JV2 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) * MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2922
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA * JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2923
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = RV2 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) * MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2924
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA * RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2925
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = DV2 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) * MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2926
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA * DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2927
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CV2 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) * MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2928
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA * CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2929
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CDV2 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2930
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA * CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2931
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMC(J,K) = TO_FM(55+5*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA * MFMC
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * MFMC(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2932
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2933
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MIMA2 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) * MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2934
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2935
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST99

      SUBROUTINE TEST100

!  Test type (IM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2936
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 4 * MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( 4 * MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2937
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 4.8 * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.8 * MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2938
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 4.87D0 * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.87D0 * MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2939
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) * MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2940
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) * MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2941
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 * 4
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) * 4 ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2942
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 * 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) * 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2943
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 * 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) * 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2944
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 * (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2945
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 * (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2946
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 * JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - ( MIM2 * JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2947
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 * RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 * RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2948
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 * DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 * DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2949
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 * CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 * CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2950
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 * CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 * CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2951
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = JV2 * MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - ( JV2(J,K) * MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2952
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = RV2 * MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) * MIM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2953
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = DV2 * MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) * MIM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2954
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = CV2 * MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MZMB2(J,K) - ( CV2(J,K) * MIM2 ))
         ENDDO
      ENDDO
      MIM2 = RSMALL*56*3
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2955
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = CDV2 * MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MIM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2956
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 * MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIM2 * MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2957
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIMA2 * MIM2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) * MIM2 ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2958
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2959
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MIMA2 * MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2960
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 * MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2961
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MZMA2 * MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST100

      SUBROUTINE TEST101

!  Test type (IM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2962
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = JV2 * MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( JV2(J,K) * MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2963
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 * JV2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) * JV2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2964
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = RV2 * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) * MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2965
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 * RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) * RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2966
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = DV2 * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) * MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2967
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 * DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) * DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2968
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CV2 * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) * MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2969
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 * CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2970
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CDV2 * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2971
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 * CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2972
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMC2(J,K) = TO_FM(37+11*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 * MIMC2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) * MIMC2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2973
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2974
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST101

      SUBROUTINE TEST102

!  Test type (ZM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2975
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4 * MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2976
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4.8 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.8 * MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2977
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4.87D0 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.87D0 * MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2978
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) * MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2979
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) * MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2980
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * 4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * 4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2981
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2982
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2983
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2984
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2985
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 * JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2986
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 * RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2987
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 * DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2988
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 * CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2989
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 * CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2990
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = JV2 * MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) * MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2991
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = RV2 * MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) * MZM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2992
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = DV2 * MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) * MZM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2993
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = CV2 * MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) * MZM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2994
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = CDV2 * MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MZM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2995
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2996
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZMA2 * MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST102

      SUBROUTINE TEST103

!  Test type (ZM) array multiplication operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 2997
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = JV2 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) * MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2998
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 2999
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = RV2 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) * MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3000
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3001
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = DV2 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) * MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3002
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3003
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = CV2 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) * MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3004
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3005
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = CDV2 * MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3006
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 * CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3007
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MZMB2(J,K) = CMPLX(TO_FM(48.3+5*(J+3*(K-1))), TO_FM(-31.4+8*(J+3*(K-1))))
         ENDDO
      ENDDO
      MZMC2 = MZMA2 * MZMB2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMC2(J,K) - ( MZMA2(J,K) * MZMB2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST103

      END MODULE TEST_G


      MODULE TEST_H
      USE TEST_VARS

      CONTAINS

      SUBROUTINE TEST104

!  Test type (FM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3008
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4 / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4 / MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3009
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4.8 / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.8 / MFMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3010
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = 4.87D0 / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.87D0 / MFMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3011
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.8,5.9) / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) / MFMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3012
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.87D0,5.98D0) / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) / MFMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3013
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 / 4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / 4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3014
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 / 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3015
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 / 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3016
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 / (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3017
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 / (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3018
      JV = (/ 12, -34, 56 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 / JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 / JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3019
      RV = (/ 12.1, -34.2, 56.3 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 / RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 / RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3020
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 / DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 / DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3021
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 / CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 / CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3022
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 / CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 / CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3023
      JV = (/ 12, -34, 56 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = JV / MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) / MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3024
      RV = (/ 12.1, -34.2, 56.3 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = RV / MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) / MFM4 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3025
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = DV / MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) / MFM4 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3026
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = CV / MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) / MFM4 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3027
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = CDV / MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MFM4 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3028
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 / MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3029
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFMV1 / MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3030
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_IM('121123456789')
      MFMV2 = MIM2 / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIM2 / MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3031
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_IM('121123456789')
      MFMV2 = MFMV1 / MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3032
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3033
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MFMV1 / MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3034
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MFM4 / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 / MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3035
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFM4 = TO_FM('12.1123456789')
      MFMV2 = MIMV1 / MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) / MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3036
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MFM4 / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 / MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3037
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFM4 = TO_FM('12.1123456789')
      MZMV2 = MZMV1 / MFM4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / MFM4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST104

      SUBROUTINE TEST105

!  Test type (FM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3038
      JV = (/ 12, -34, 56 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = JV / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) / MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3039
      JV = (/ 12, -34, 56 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 / JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3040
      RV = (/ 12.1, -34.2, 56.3 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = RV / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) / MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3041
      RV = (/ 12.1, -34.2, 56.3 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 / RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3042
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = DV / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) / MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3043
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV2 = MFMV1 / DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3044
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CV / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) / MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3045
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 / CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3046
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CDV / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3047
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 / CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3048
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MFMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
      MFMV2 = MFMV1 / MFMV4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / MFMV4(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3049
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MFMV2 = MFMV1 / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3050
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MFMV2 = MIMV1 / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) / MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3051
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MZMV1 / MFMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / MFMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3052
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MFMV1 / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST105

      SUBROUTINE TEST106

!  Test type (IM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3053
      MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
      MIMV2 = 4 / MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( 4 / MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3054
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = 4.8 / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.8 / MIMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3055
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = 4.87D0 / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.87D0 / MIMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3056
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.8,5.9) / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) / MIMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3057
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = (4.87D0,5.98D0) / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) / MIMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3058
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 / 4
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) / 4 ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3059
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 / 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) / 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3060
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 / 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) / 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3061
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 / (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3062
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 / (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3063
      JV = (/ 12, -34, 56 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 / JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - ( MIM2 / JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3064
      RV = (/ 12.1, -34.2, 56.3 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 / RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 / RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3065
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 / DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 / DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3066
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 / CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 / CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3067
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 / CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 / CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3068
      JV = (/ 12, -34, 56 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = JV / MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - ( JV(J) / MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3069
      RV = (/ 12.1, -34.2, 56.3 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = RV / MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) / MIM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3070
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = DV / MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) / MIM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3071
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = CV / MIM2
      MFM3 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MZMV2(J) - ( CV(J) / MIM2 ))
      ENDDO
      MIM2 = RSMALL*56*3
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3072
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = CDV / MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MIM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3073
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIM2 / MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIM2 / MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3074
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIM2 = TO_FM('12.1123456789')
      MIMV2 = MIMV1 / MIM2
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) / MIM2 ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3075
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3076
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MIMV1 / MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3077
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MIM2 / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 / MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3078
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIM2 = TO_FM('12.1123456789')
      MZMV2 = MZMV1 / MIM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / MIM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST106

      SUBROUTINE TEST107

!  Test type (IM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3079
      JV = (/ 12, -34, 56 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = JV / MIMV1
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( JV(J) / MIMV1(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3080
      JV = (/ 12, -34, 56 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 / JV
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) / JV(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3081
      RV = (/ 12.1, -34.2, 56.3 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = RV / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) / MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3082
      RV = (/ 12.1, -34.2, 56.3 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 / RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) / RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3083
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = DV / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) / MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3084
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV2 = MIMV1 / DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) / DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3085
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CV / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) / MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3086
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 / CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3087
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = CDV / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3088
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 / CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3089
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MIMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
      MIMV2 = MIMV1 / MIMV4
      MIM1 = 0
      DO J = 1, 3
         MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) / MIMV4(J) ))
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3090
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MZMV1 / MIMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / MIMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3091
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
      MZMV2 = MIMV1 / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST107

      SUBROUTINE TEST108

!  Test type (ZM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3092
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4 / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4 / MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3093
      MFMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4.8 / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.8 / MZMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3094
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = 4.87D0 / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.87D0 / MZMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3095
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (4.8,5.9) / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) / MZMV1(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3096
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (4.87D0,5.98D0) / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) / MZMV1(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3097
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 / 4
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / 4 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3098
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 / 4.8
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / 4.8 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3099
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 / 4.87D0
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / 4.87D0 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3100
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 / (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / (4.8,5.9) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3101
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 / (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / (4.87D0,5.98D0) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3102
      JV = (/ 12, -34, 56 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 / JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3103
      RV = (/ 12.1, -34.2, 56.3 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 / RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / RV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3104
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 / DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / DV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3105
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 / CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / CV(J) ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3106
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = MZM2 / CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / CDV(J) ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3107
      JV = (/ 12, -34, 56 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = JV / MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) / MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3108
      RV = (/ 12.1, -34.2, 56.3 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = RV / MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) / MZM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3109
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = DV / MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) / MZM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3110
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = CV / MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) / MZM2 ))
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3111
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMV2 = CDV / MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MZM2 ))
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3112
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZM2 / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3113
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMV2 = MZMV1 / MZM2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / MZM2 ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST108

      SUBROUTINE TEST109

!  Test type (ZM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3114
      JV = (/ 12, -34, 56 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = JV / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) / MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3115
      JV = (/ 12, -34, 56 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 / JV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / JV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3116
      RV = (/ 12.1, -34.2, 56.3 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = RV / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) / MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3117
      RV = (/ 12.1, -34.2, 56.3 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 / RV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / RV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3118
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = DV / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) / MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3119
      DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 / DV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / DV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3120
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = CV / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) / MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3121
      CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 / CV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / CV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3122
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = CDV / MZMV1
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MZMV1(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3123
      CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) ,  &
               (56.3123456789D0,-465.84D0) /)
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = MZMV1 / CDV
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / CDV(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3124
      MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') ,  &
                 TO_ZM('56.3123456789 + 0.000345 i') /)
      MZMV2 = (/ TO_ZM('1.21123456789 + 0.9574635 i') , TO_ZM('-3.42123456789 - 0.54 i') ,  &
                 TO_ZM('5.63123456789 + 0.00345 i') /)
      MZMV4 = MZMV1 / MZMV2
      MFM3 = 0
      DO J = 1, 3
         MFM3 = MFM3 + ABS(MZMV4(J) - ( MZMV1(J) / MZMV2(J) ))
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST109

      SUBROUTINE TEST110

!  Test type (FM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3125
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4 / MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3126
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4.8 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.8 / MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3127
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = 4.87D0 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.87D0 / MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3128
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) / MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3129
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) / MFMA(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3130
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA / 4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / 4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3131
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA / 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3132
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA / 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3133
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA / (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3134
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA / (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3135
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 / JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 / JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3136
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 / RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 / RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3137
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 / DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 / DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3138
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 / CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 / CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3139
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 / CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 / CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3140
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = JV2 / MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) / MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3141
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = RV2 / MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) / MFM4 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3142
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MFMB = DV2 / MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) / MFM4 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3143
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = CV2 / MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) / MFM4 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3144
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = CDV2 / MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MFM4 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3145
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 / MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3146
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFMA / MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3147
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_IM('121123456789')
      MFMB = MIM2 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIM2 / MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3148
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_IM('121123456789')
      MFMB = MFMA / MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3149
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3150
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MFMA / MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3151
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MFM4 / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 / MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3152
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MFMB = MIMA2 / MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) / MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3153
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MFM4 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 / MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3154
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MFM4 = TO_FM('12.1123456789')
      MZMB2 = MZMA2 / MFM4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / MFM4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST110

      SUBROUTINE TEST111

!  Test type (FM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3155
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = JV2 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) / MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3156
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA / JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3157
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = RV2 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) / MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3158
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA / RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3159
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = DV2 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) / MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3160
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA / DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3161
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CV2 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) / MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3162
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA / CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3163
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CDV2 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3164
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA / CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3165
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMC(J,K) = TO_FM(55+5*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA / MFMC
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / MFMC(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3166
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MFMA / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3167
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MFMB = MIMA2 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) / MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3168
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / MFMA
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / MFMA(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3169
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MFMA / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST111

      SUBROUTINE TEST112

!  Test type (IM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3170
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 412345 / MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( 412345 / MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3171
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 412345.8 / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 412345.8 / MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3172
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = 412345.87D0 / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 412345.87D0 / MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3173
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) / MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3174
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) / MIMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3175
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 / 4
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) / 4 ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3176
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 / 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) / 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3177
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 / 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) / 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3178
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 / (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3179
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 / (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3180
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 / JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - ( MIM2 / JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3181
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 / RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 / RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3182
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 / DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 / DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3183
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 / CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 / CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3184
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 / CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 / CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3185
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = JV2 / MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - ( JV2(J,K) / MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3186
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = RV2 / MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) / MIM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3187
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = DV2 / MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) / MIM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3188
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = CV2 / MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MZMB2(J,K) - ( CV2(J,K) / MIM2 ))
         ENDDO
      ENDDO
      MIM2 = RSMALL*56*3
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3189
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = CDV2 / MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MIM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3190
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIM2 / MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIM2 / MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3191
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MIMB2 = MIMA2 / MIM2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) / MIM2 ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3192
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3193
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MIMA2 / MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3194
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MIM2 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 / MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3195
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MIM2 = TO_FM('12.1123456789')
      MZMB2 = MZMA2 / MIM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / MIM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST112

      SUBROUTINE TEST113

!  Test type (IM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3196
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = JV2 / MIMA2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( JV2(J,K) / MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3197
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 / JV2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) / JV2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3198
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = RV2 / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) / MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3199
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 / RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) / RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3200
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = DV2 / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) / MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3201
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 / DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) / DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3202
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CV2 / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) / MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3203
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 / CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3204
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = CDV2 / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3205
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 / CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3206
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMC2(J,K) = TO_FM(37+11*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MIMB2 = MIMA2 / MIMC2
      MIM1 = 0
      DO J = 1, 3
         DO K = 1, 3
            MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) / MIMC2(J,K) ))
         ENDDO
      ENDDO
      CALL IM_ST2M(' 0 ',MIM2)
      IF (.NOT.(MIM1 <= MIM2)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3207
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / MIMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / MIMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3208
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
         ENDDO
      ENDDO
      MZMB2 = MIMA2 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST113

      SUBROUTINE TEST114

!  Test type (ZM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3209
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4 / MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3210
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4.8 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.8 / MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3211
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = 4.87D0 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.87D0 / MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3212
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = (4.8,5.9) / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) / MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3213
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = (4.87D0,5.98D0) / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) / MZMA2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3214
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / 4
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / 4 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3215
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / 4.8
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / 4.8 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3216
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / 4.87D0
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / 4.87D0 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3217
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / (4.8,5.9)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / (4.8,5.9) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3218
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / (4.87D0,5.98D0)
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / (4.87D0,5.98D0) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3219
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 / JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3220
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 / RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / RV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3221
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 / DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / DV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3222
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 / CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / CV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3223
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = MZM2 / CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / CDV2(J,K) ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3224
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = JV2 / MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) / MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3225
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = RV2 / MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) / MZM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3226
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = DV2 / MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) / MZM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3227
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = CV2 / MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) / MZM2 ))
         ENDDO
      ENDDO
      MFM4 = RSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3228
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
      MZMB2 = CDV2 / MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MZM2 ))
         ENDDO
      ENDDO
      MFM4 = DSMALL*56*3
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3229
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZM2 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3230
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZM2 = TO_ZM('-123.654 + 98.7 i')
      MZMB2 = MZMA2 / MZM2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / MZM2 ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST114

      SUBROUTINE TEST115

!  Test type (ZM) array division operations.

      IMPLICIT NONE

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')

      NCASE = 3231
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = JV2 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) / MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3232
      JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / JV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / JV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3233
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = RV2 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) / MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3234
      RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / RV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / RV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3235
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = DV2 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) / MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3236
      DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / DV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / DV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3237
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = CV2 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) / MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3238
      CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / CV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / CV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3239
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = CDV2 / MZMA2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MZMA2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3240
      CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      MZMB2 = MZMA2 / CDV2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / CDV2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3241
      DO J = 1, 3
         DO K = 1, 3
            MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
         ENDDO
      ENDDO
      DO J = 1, 3
         DO K = 1, 3
            MZMB2(J,K) = CMPLX(TO_FM(48.3+5*(J+3*(K-1))), TO_FM(-31.4+8*(J+3*(K-1))))
         ENDDO
      ENDDO
      MZMC2 = MZMA2 / MZMB2
      MFM3 = 0
      DO J = 1, 3
         DO K = 1, 3
            MFM3 = MFM3 + ABS(MZMC2(J,K) - ( MZMA2(J,K) / MZMB2(J,K) ))
         ENDDO
      ENDDO
      CALL FM_ST2M(' 1.0E-45 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST115

      SUBROUTINE TEST116

!  Test higher precision operations.

      IMPLICIT NONE

      WRITE (KW,"(/' Testing higher precision operations using 20,000 significant digits.')")

      CALL FMSET(20000)

      KWSAVE = KW
      CALL FMSETVAR(' KW = 22 ')
      CALL FMSETVAR(' KDEBUG = 0 ')

      NCASE = 3242
      WRITE (KWSAVE,"(/'     Check pi.')")
      CALL FM_PI(M_A)

      OPEN (23,FILE='TEMPFM')
      WRITE (23,*) '3.1415926535897932384626433832795028841971693993751058209749445923078164062862&'
      WRITE (23,*) '089986280348253421170679821480865132823066470938446095505822317253594081284811&'
      WRITE (23,*) '174502841027019385211055596446229489549303819644288109756659334461284756482337&'
      WRITE (23,*) '867831652712019091456485669234603486104543266482133936072602491412737245870066&'
      WRITE (23,*) '063155881748815209209628292540917153643678925903600113305305488204665213841469&'
      WRITE (23,*) '519415116094330572703657595919530921861173819326117931051185480744623799627495&'
      WRITE (23,*) '673518857527248912279381830119491298336733624406566430860213949463952247371907&'
      WRITE (23,*) '021798609437027705392171762931767523846748184676694051320005681271452635608277&'
      WRITE (23,*) '857713427577896091736371787214684409012249534301465495853710507922796892589235&'
      WRITE (23,*) '420199561121290219608640344181598136297747713099605187072113499999983729780499&'
      WRITE (23,*) '510597317328160963185950244594553469083026425223082533446850352619311881710100&'
      WRITE (23,*) '031378387528865875332083814206171776691473035982534904287554687311595628638823&'
      WRITE (23,*) '537875937519577818577805321712268066130019278766111959092164201989380952572010&'
      WRITE (23,*) '654858632788659361533818279682303019520353018529689957736225994138912497217752&'
      WRITE (23,*) '834791315155748572424541506959508295331168617278558890750983817546374649393192&'
      WRITE (23,*) '550604009277016711390098488240128583616035637076601047101819429555961989467678&'
      WRITE (23,*) '374494482553797747268471040475346462080466842590694912933136770289891521047521&'
      WRITE (23,*) '620569660240580381501935112533824300355876402474964732639141992726042699227967&'
      WRITE (23,*) '823547816360093417216412199245863150302861829745557067498385054945885869269956&'
      WRITE (23,*) '909272107975093029553211653449872027559602364806654991198818347977535663698074&'
      WRITE (23,*) '265425278625518184175746728909777727938000816470600161452491921732172147723501&'
      WRITE (23,*) '414419735685481613611573525521334757418494684385233239073941433345477624168625&'
      WRITE (23,*) '189835694855620992192221842725502542568876717904946016534668049886272327917860&'
      WRITE (23,*) '857843838279679766814541009538837863609506800642251252051173929848960841284886&'
      WRITE (23,*) '269456042419652850222106611863067442786220391949450471237137869609563643719172&'
      WRITE (23,*) '874677646575739624138908658326459958133904780275900994657640789512694683983525&'
      WRITE (23,*) '957098258226205224894077267194782684826014769909026401363944374553050682034962&'
      WRITE (23,*) '524517493996514314298091906592509372216964615157098583874105978859597729754989&'
      WRITE (23,*) '301617539284681382686838689427741559918559252459539594310499725246808459872736&'
      WRITE (23,*) '446958486538367362226260991246080512438843904512441365497627807977156914359977&'
      WRITE (23,*) '001296160894416948685558484063534220722258284886481584560285060168427394522674&'
      WRITE (23,*) '676788952521385225499546667278239864565961163548862305774564980355936345681743&'
      WRITE (23,*) '241125150760694794510965960940252288797108931456691368672287489405601015033086&'
      WRITE (23,*) '179286809208747609178249385890097149096759852613655497818931297848216829989487&'
      WRITE (23,*) '226588048575640142704775551323796414515237462343645428584447952658678210511413&'
      WRITE (23,*) '547357395231134271661021359695362314429524849371871101457654035902799344037420&'
      WRITE (23,*) '073105785390621983874478084784896833214457138687519435064302184531910484810053&'
      WRITE (23,*) '706146806749192781911979399520614196634287544406437451237181921799983910159195&'
      WRITE (23,*) '618146751426912397489409071864942319615679452080951465502252316038819301420937&'
      WRITE (23,*) '621378559566389377870830390697920773467221825625996615014215030680384477345492&'
      WRITE (23,*) '026054146659252014974428507325186660021324340881907104863317346496514539057962&'
      WRITE (23,*) '685610055081066587969981635747363840525714591028970641401109712062804390397595&'
      WRITE (23,*) '156771577004203378699360072305587631763594218731251471205329281918261861258673&'
      WRITE (23,*) '215791984148488291644706095752706957220917567116722910981690915280173506712748&'
      WRITE (23,*) '583222871835209353965725121083579151369882091444210067510334671103141267111369&'
      WRITE (23,*) '908658516398315019701651511685171437657618351556508849099898599823873455283316&'
      WRITE (23,*) '355076479185358932261854896321329330898570642046752590709154814165498594616371&'
      WRITE (23,*) '802709819943099244889575712828905923233260972997120844335732654893823911932597&'
      WRITE (23,*) '463667305836041428138830320382490375898524374417029132765618093773444030707469&'
      WRITE (23,*) '211201913020330380197621101100449293215160842444859637669838952286847831235526&'
      WRITE (23,*) '582131449576857262433441893039686426243410773226978028073189154411010446823252&'
      WRITE (23,*) '716201052652272111660396665573092547110557853763466820653109896526918620564769&'
      WRITE (23,*) '312570586356620185581007293606598764861179104533488503461136576867532494416680&'
      WRITE (23,*) '396265797877185560845529654126654085306143444318586769751456614068007002378776&'
      WRITE (23,*) '591344017127494704205622305389945613140711270004078547332699390814546646458807&'
      WRITE (23,*) '972708266830634328587856983052358089330657574067954571637752542021149557615814&'
      WRITE (23,*) '002501262285941302164715509792592309907965473761255176567513575178296664547791&'
      WRITE (23,*) '745011299614890304639947132962107340437518957359614589019389713111790429782856&'
      WRITE (23,*) '475032031986915140287080859904801094121472213179476477726224142548545403321571&'
      WRITE (23,*) '853061422881375850430633217518297986622371721591607716692547487389866549494501&'
      WRITE (23,*) '146540628433663937900397692656721463853067360965712091807638327166416274888800&'
      WRITE (23,*) '786925602902284721040317211860820419000422966171196377921337575114959501566049&'
      WRITE (23,*) '631862947265473642523081770367515906735023507283540567040386743513622224771589&'
      WRITE (23,*) '150495309844489333096340878076932599397805419341447377441842631298608099888687&'
      WRITE (23,*) '413260472156951623965864573021631598193195167353812974167729478672422924654366&'
      WRITE (23,*) '800980676928238280689964004824354037014163149658979409243237896907069779422362&'
      WRITE (23,*) '508221688957383798623001593776471651228935786015881617557829735233446042815126&'
      WRITE (23,*) '272037343146531977774160319906655418763979293344195215413418994854447345673831&'
      WRITE (23,*) '624993419131814809277771038638773431772075456545322077709212019051660962804909&'
      WRITE (23,*) '263601975988281613323166636528619326686336062735676303544776280350450777235547&'
      WRITE (23,*) '105859548702790814356240145171806246436267945612753181340783303362542327839449&'
      WRITE (23,*) '753824372058353114771199260638133467768796959703098339130771098704085913374641&'
      WRITE (23,*) '442822772634659470474587847787201927715280731767907707157213444730605700733492&'
      WRITE (23,*) '436931138350493163128404251219256517980694113528013147013047816437885185290928&'
      WRITE (23,*) '545201165839341965621349143415956258658655705526904965209858033850722426482939&'
      WRITE (23,*) '728584783163057777560688876446248246857926039535277348030480290058760758251047&'
      WRITE (23,*) '470916439613626760449256274204208320856611906254543372131535958450687724602901&'
      WRITE (23,*) '618766795240616342522577195429162991930645537799140373404328752628889639958794&'
      WRITE (23,*) '757291746426357455254079091451357111369410911939325191076020825202618798531887&'
      WRITE (23,*) '705842972591677813149699009019211697173727847684726860849003377024242916513005&'
      WRITE (23,*) '005168323364350389517029893922334517220138128069650117844087451960121228599371&'
      WRITE (23,*) '623130171144484640903890644954440061986907548516026327505298349187407866808818&'
      WRITE (23,*) '338510228334508504860825039302133219715518430635455007668282949304137765527939&'
      WRITE (23,*) '751754613953984683393638304746119966538581538420568533862186725233402830871123&'
      WRITE (23,*) '282789212507712629463229563989898935821167456270102183564622013496715188190973&'
      WRITE (23,*) '038119800497340723961036854066431939509790190699639552453005450580685501956730&'
      WRITE (23,*) '229219139339185680344903982059551002263535361920419947455385938102343955449597&'
      WRITE (23,*) '783779023742161727111723643435439478221818528624085140066604433258885698670543&'
      WRITE (23,*) '154706965747458550332323342107301545940516553790686627333799585115625784322988&'
      WRITE (23,*) '273723198987571415957811196358330059408730681216028764962867446047746491599505&'
      WRITE (23,*) '497374256269010490377819868359381465741268049256487985561453723478673303904688&'
      WRITE (23,*) '383436346553794986419270563872931748723320837601123029911367938627089438799362&'
      WRITE (23,*) '016295154133714248928307220126901475466847653576164773794675200490757155527819&'
      WRITE (23,*) '653621323926406160136358155907422020203187277605277219005561484255518792530343&'
      WRITE (23,*) '513984425322341576233610642506390497500865627109535919465897514131034822769306&'
      WRITE (23,*) '247435363256916078154781811528436679570611086153315044521274739245449454236828&'
      WRITE (23,*) '860613408414863776700961207151249140430272538607648236341433462351897576645216&'
      WRITE (23,*) '413767969031495019108575984423919862916421939949072362346468441173940326591840&'
      WRITE (23,*) '443780513338945257423995082965912285085558215725031071257012668302402929525220&'
      WRITE (23,*) '118726767562204154205161841634847565169998116141010029960783869092916030288400&'
      WRITE (23,*) '269104140792886215078424516709087000699282120660418371806535567252532567532861&'
      WRITE (23,*) '291042487761825829765157959847035622262934860034158722980534989650226291748788&'
      WRITE (23,*) '202734209222245339856264766914905562842503912757710284027998066365825488926488&'
      WRITE (23,*) '025456610172967026640765590429099456815065265305371829412703369313785178609040&'
      WRITE (23,*) '708667114965583434347693385781711386455873678123014587687126603489139095620099&'
      WRITE (23,*) '393610310291616152881384379099042317473363948045759314931405297634757481193567&'
      WRITE (23,*) '091101377517210080315590248530906692037671922033229094334676851422144773793937&'
      WRITE (23,*) '517034436619910403375111735471918550464490263655128162288244625759163330391072&'
      WRITE (23,*) '253837421821408835086573917715096828874782656995995744906617583441375223970968&'
      WRITE (23,*) '340800535598491754173818839994469748676265516582765848358845314277568790029095&'
      WRITE (23,*) '170283529716344562129640435231176006651012412006597558512761785838292041974844&'
      WRITE (23,*) '236080071930457618932349229279650198751872127267507981255470958904556357921221&'
      WRITE (23,*) '033346697499235630254947802490114195212382815309114079073860251522742995818072&'
      WRITE (23,*) '471625916685451333123948049470791191532673430282441860414263639548000448002670&'
      WRITE (23,*) '496248201792896476697583183271314251702969234889627668440323260927524960357996&'
      WRITE (23,*) '469256504936818360900323809293459588970695365349406034021665443755890045632882&'
      WRITE (23,*) '250545255640564482465151875471196218443965825337543885690941130315095261793780&'
      WRITE (23,*) '029741207665147939425902989695946995565761218656196733786236256125216320862869&'
      WRITE (23,*) '222103274889218654364802296780705765615144632046927906821207388377814233562823&'
      WRITE (23,*) '608963208068222468012248261177185896381409183903673672220888321513755600372798&'
      WRITE (23,*) '394004152970028783076670944474560134556417254370906979396122571429894671543578&'
      WRITE (23,*) '468788614445812314593571984922528471605049221242470141214780573455105008019086&'
      WRITE (23,*) '996033027634787081081754501193071412233908663938339529425786905076431006383519&'
      WRITE (23,*) '834389341596131854347546495569781038293097164651438407007073604112373599843452&'
      WRITE (23,*) '251610507027056235266012764848308407611830130527932054274628654036036745328651&'
      WRITE (23,*) '057065874882256981579367897669742205750596834408697350201410206723585020072452&'
      WRITE (23,*) '256326513410559240190274216248439140359989535394590944070469120914093870012645&'
      WRITE (23,*) '600162374288021092764579310657922955249887275846101264836999892256959688159205&'
      WRITE (23,*) '600101655256375678566722796619885782794848855834397518744545512965634434803966&'
      WRITE (23,*) '420557982936804352202770984294232533022576341807039476994159791594530069752148&'
      WRITE (23,*) '293366555661567873640053666564165473217043903521329543529169414599041608753201&'
      WRITE (23,*) '868379370234888689479151071637852902345292440773659495630510074210871426134974&'
      WRITE (23,*) '595615138498713757047101787957310422969066670214498637464595280824369445789772&'
      WRITE (23,*) '330048764765241339075920434019634039114732023380715095222010682563427471646024&'
      WRITE (23,*) '335440051521266932493419673977041595683753555166730273900749729736354964533288&'
      WRITE (23,*) '869844061196496162773449518273695588220757355176651589855190986665393549481068&'
      WRITE (23,*) '873206859907540792342402300925900701731960362254756478940647548346647760411463&'
      WRITE (23,*) '233905651343306844953979070903023460461470961696886885014083470405460742958699&'
      WRITE (23,*) '138296682468185710318879065287036650832431974404771855678934823089431068287027&'
      WRITE (23,*) '228097362480939962706074726455399253994428081137369433887294063079261595995462&'
      WRITE (23,*) '624629707062594845569034711972996409089418059534393251236235508134949004364278&'
      WRITE (23,*) '527138315912568989295196427287573946914272534366941532361004537304881985517065&'
      WRITE (23,*) '941217352462589548730167600298865925786628561249665523533829428785425340483083&'
      WRITE (23,*) '307016537228563559152534784459818313411290019992059813522051173365856407826484&'
      WRITE (23,*) '942764411376393866924803118364453698589175442647399882284621844900877769776312&'
      WRITE (23,*) '795722672655562596282542765318300134070922334365779160128093179401718598599933&'
      WRITE (23,*) '849235495640057099558561134980252499066984233017350358044081168552653117099570&'
      WRITE (23,*) '899427328709258487894436460050410892266917835258707859512983441729535195378855&'
      WRITE (23,*) '345737426085902908176515578039059464087350612322611200937310804854852635722825&'
      WRITE (23,*) '768203416050484662775045003126200800799804925485346941469775164932709504934639&'
      WRITE (23,*) '382432227188515974054702148289711177792376122578873477188196825462981268685817&'
      WRITE (23,*) '050740272550263329044976277894423621674119186269439650671515779586756482399391&'
      WRITE (23,*) '760426017633870454990176143641204692182370764887834196896861181558158736062938&'
      WRITE (23,*) '603810171215855272668300823834046564758804051380801633638874216371406435495561&'
      WRITE (23,*) '868964112282140753302655100424104896783528588290243670904887118190909494533144&'
      WRITE (23,*) '218287661810310073547705498159680772009474696134360928614849417850171807793068&'
      WRITE (23,*) '108546900094458995279424398139213505586422196483491512639012803832001097738680&'
      WRITE (23,*) '662877923971801461343244572640097374257007359210031541508936793008169980536520&'
      WRITE (23,*) '276007277496745840028362405346037263416554259027601834840306811381855105979705&'
      WRITE (23,*) '664007509426087885735796037324514146786703688098806097164258497595138069309449&'
      WRITE (23,*) '401515422221943291302173912538355915031003330325111749156969174502714943315155&'
      WRITE (23,*) '885403922164097229101129035521815762823283182342548326111912800928252561902052&'
      WRITE (23,*) '630163911477247331485739107775874425387611746578671169414776421441111263583553&'
      WRITE (23,*) '871361011023267987756410246824032264834641766369806637857681349204530224081972&'
      WRITE (23,*) '785647198396308781543221166912246415911776732253264335686146186545222681268872&'
      WRITE (23,*) '684459684424161078540167681420808850280054143613146230821025941737562389942075&'
      WRITE (23,*) '713627516745731891894562835257044133543758575342698699472547031656613991999682&'
      WRITE (23,*) '628247270641336222178923903176085428943733935618891651250424404008952719837873&'
      WRITE (23,*) '864805847268954624388234375178852014395600571048119498842390606136957342315590&'
      WRITE (23,*) '796703461491434478863604103182350736502778590897578272731305048893989009923913&'
      WRITE (23,*) '503373250855982655867089242612429473670193907727130706869170926462548423240748&'
      WRITE (23,*) '550366080136046689511840093668609546325002145852930950000907151058236267293264&'
      WRITE (23,*) '537382104938724996699339424685516483261134146110680267446637334375340764294026&'
      WRITE (23,*) '682973865220935701626384648528514903629320199199688285171839536691345222444708&'
      WRITE (23,*) '045923966028171565515656661113598231122506289058549145097157553900243931535190&'
      WRITE (23,*) '902107119457300243880176615035270862602537881797519478061013715004489917210022&'
      WRITE (23,*) '201335013106016391541589578037117792775225978742891917915522417189585361680594&'
      WRITE (23,*) '741234193398420218745649256443462392531953135103311476394911995072858430658361&'
      WRITE (23,*) '935369329699289837914941939406085724863968836903265564364216644257607914710869&'
      WRITE (23,*) '984315733749648835292769328220762947282381537409961545598798259891093717126218&'
      WRITE (23,*) '283025848112389011968221429457667580718653806506487026133892822994972574530332&'
      WRITE (23,*) '838963818439447707794022843598834100358385423897354243956475556840952248445541&'
      WRITE (23,*) '392394100016207693636846776413017819659379971557468541946334893748439129742391&'
      WRITE (23,*) '433659360410035234377706588867781139498616478747140793263858738624732889645643&'
      WRITE (23,*) '598774667638479466504074111825658378878454858148962961273998413442726086061872&'
      WRITE (23,*) '455452360643153710112746809778704464094758280348769758948328241239292960582948&'
      WRITE (23,*) '619196670918958089833201210318430340128495116203534280144127617285830243559830&'
      WRITE (23,*) '032042024512072872535581195840149180969253395075778400067465526031446167050827&'
      WRITE (23,*) '682772223534191102634163157147406123850425845988419907611287258059113935689601&'
      WRITE (23,*) '431668283176323567325417073420817332230462987992804908514094790368878687894930&'
      WRITE (23,*) '546955703072619009502076433493359106024545086453628935456862958531315337183868&'
      WRITE (23,*) '265617862273637169757741830239860065914816164049449650117321313895747062088474&'
      WRITE (23,*) '802365371031150898427992754426853277974311395143574172219759799359685252285745&'
      WRITE (23,*) '263796289612691572357986620573408375766873884266405990993505000813375432454635&'
      WRITE (23,*) '967504844235284874701443545419576258473564216198134073468541117668831186544893&'
      WRITE (23,*) '776979566517279662326714810338643913751865946730024434500544995399742372328712&'
      WRITE (23,*) '494834706044063471606325830649829795510109541836235030309453097335834462839476&'
      WRITE (23,*) '304775645015008507578949548931393944899216125525597701436858943585877526379625&'
      WRITE (23,*) '597081677643800125436502371412783467926101995585224717220177723700417808419423&'
      WRITE (23,*) '948725406801556035998390548985723546745642390585850216719031395262944554391316&'
      WRITE (23,*) '631345308939062046784387785054239390524731362012947691874975191011472315289326&'
      WRITE (23,*) '772533918146607300089027768963114810902209724520759167297007850580717186381054&'
      WRITE (23,*) '967973100167870850694207092232908070383263453452038027860990556900134137182368&'
      WRITE (23,*) '370991949516489600755049341267876436746384902063964019766685592335654639138363&'
      WRITE (23,*) '185745698147196210841080961884605456039038455343729141446513474940784884423772&'
      WRITE (23,*) '175154334260306698831768331001133108690421939031080143784334151370924353013677&'
      WRITE (23,*) '631084913516156422698475074303297167469640666531527035325467112667522460551199&'
      WRITE (23,*) '581831963763707617991919203579582007595605302346267757943936307463056901080114&'
      WRITE (23,*) '942714100939136913810725813781357894005599500183542511841721360557275221035268&'
      WRITE (23,*) '037357265279224173736057511278872181908449006178013889710770822931002797665935&'
      WRITE (23,*) '838758909395688148560263224393726562472776037890814458837855019702843779362407&'
      WRITE (23,*) '825052704875816470324581290878395232453237896029841669225489649715606981192186&'
      WRITE (23,*) '584926770403956481278102179913217416305810554598801300484562997651121241536374&'
      WRITE (23,*) '515005635070127815926714241342103301566165356024733807843028655257222753049998&'
      WRITE (23,*) '837015348793008062601809623815161366903341111386538510919367393835229345888322&'
      WRITE (23,*) '550887064507539473952043968079067086806445096986548801682874343786126453815834&'
      WRITE (23,*) '280753061845485903798217994599681154419742536344399602902510015888272164745006&'
      WRITE (23,*) '820704193761584547123183460072629339550548239557137256840232268213012476794522&'
      WRITE (23,*) '644820910235647752723082081063518899152692889108455571126603965034397896278250&'
      WRITE (23,*) '016110153235160519655904211844949907789992007329476905868577878720982901352956&'
      WRITE (23,*) '613978884860509786085957017731298155314951681467176959760994210036183559138777&'
      WRITE (23,*) '817698458758104466283998806006162298486169353373865787735983361613384133853684&'
      WRITE (23,*) '211978938900185295691967804554482858483701170967212535338758621582310133103877&'
      WRITE (23,*) '668272115726949518179589754693992642197915523385766231676275475703546994148929&'
      WRITE (23,*) '041301863861194391962838870543677743224276809132365449485366768000001065262485&'
      WRITE (23,*) '473055861598999140170769838548318875014293890899506854530765116803337322265175&'
      WRITE (23,*) '662207526951791442252808165171667766727930354851542040238174608923283917032754&'
      WRITE (23,*) '257508676551178593950027933895920576682789677644531840404185540104351348389531&'
      WRITE (23,*) '201326378369283580827193783126549617459970567450718332065034556644034490453627&'
      WRITE (23,*) '560011250184335607361222765949278393706478426456763388188075656121689605041611&'
      WRITE (23,*) '390390639601620221536849410926053876887148379895599991120991646464411918568277&'
      WRITE (23,*) '004574243434021672276445589330127781586869525069499364610175685060167145354315&'
      WRITE (23,*) '814801054588605645501332037586454858403240298717093480910556211671546848477803&'
      WRITE (23,*) '944756979804263180991756422809873998766973237695737015808068229045992123661689&'
      WRITE (23,*) '025962730430679316531149401764737693873514093361833216142802149763399189835484&'
      WRITE (23,*) '875625298752423873077559555955465196394401821840998412489826236737714672260616&'
      WRITE (23,*) '336432964063357281070788758164043814850188411431885988276944901193212968271588&'
      WRITE (23,*) '841338694346828590066640806314077757725705630729400492940302420498416565479736&'
      WRITE (23,*) '705485580445865720227637840466823379852827105784319753541795011347273625774080&'
      WRITE (23,*) '213476826045022851579795797647467022840999561601569108903845824502679265942055&'
      WRITE (23,*) '503958792298185264800706837650418365620945554346135134152570065974881916341359&'
      WRITE (23,*) '556719649654032187271602648593049039787489589066127250794828276938953521753621&'
      WRITE (23,*) '850796297785146188432719223223810158744450528665238022532843891375273845892384&'
      WRITE (23,*) '422535472653098171578447834215822327020690287232330053862163479885094695472004&'
      WRITE (23,*) '795231120150432932266282727632177908840087861480221475376578105819702226309717&'
      WRITE (23,*) '495072127248479478169572961423658595782090830733233560348465318730293026659645&'
      WRITE (23,*) '013718375428897557971449924654038681799213893469244741985097334626793321072686&'
      WRITE (23,*) '870768062639919361965044099542167627840914669856925715074315740793805323925239&'
      WRITE (23,*) '477557441591845821562518192155233709607483329234921034514626437449805596103307&'
      WRITE (23,*) '994145347784574699992128599999399612281615219314888769388022281083001986016549&'
      WRITE (23,*) '416542616968586788372609587745676182507275992950893180521872924610867639958916&'
      WRITE (23,*) '145855058397274209809097817293239301067663868240401113040247007350857828724627&'
      WRITE (23,*) '134946368531815469690466968693925472519413992914652423857762550047485295476814&'
      WRITE (23,*) '795467007050347999588867695016124972282040303995463278830695976249361510102436&'
      WRITE (23,*) '555352230690612949388599015734661023712235478911292547696176005047974928060721&'
      WRITE (23,*) '268039226911027772261025441492215765045081206771735712027180242968106203776578&'
      WRITE (23,*) '837166909109418074487814049075517820385653909910477594141321543284406250301803'
      WRITE (23,*) ' '

      CLOSE(23)

      OPEN (23,FILE='TEMPFM')
      CALL FM_READ(23,M_D)
      CLOSE(23)
      MFM3 = ABS(M_A - M_D)
      CALL FM_ST2M(' 1.0E-20000 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3243
      J1 = MBASE
      J2 = NDIG
      IF (12345678 <= MXBASE) THEN
          CALL FM_SETVAR(" MBASE = 12345678 ")
          CALL FM_SETVAR(" NDIG  = 2822 ")
      ELSE IF (12345 <= MXBASE) THEN
          CALL FM_SETVAR(" MBASE = 12345 ")
          CALL FM_SETVAR(" NDIG  = 4890 ")
      ELSE
          CALL FM_SETVAR(" MBASE = 123 ")
          CALL FM_SETVAR(" NDIG  = 9572 ")
      ENDIF
      CALL FM_PI(M_A)
      OPEN (23,FILE='TEMPFM')
      CALL FM_READ(23,M_C)
      CLOSE(23)
      MFM3 = ABS(M_A - M_C)
      CALL FM_ST2M(' 1.0E-20000 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3244
      CALL FM_CHANGEBASE(M_A,M_B,J1,J2)
      CALL FMSET(20000)
      MFM3 = ABS(M_B - M_D)
      CALL FM_ST2M(' 1.0E-20000 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3245
      WRITE (KWSAVE,"(/'     Check e.')")
      M_B = 1
      M_A = EXP(M_B)

      OPEN (23,FILE='TEMPFM')
      WRITE (23,*) '2.7182818284590452353602874713526624977572470936999595749669676277240766303535&'
      WRITE (23,*) '475945713821785251664274274663919320030599218174135966290435729003342952605956&'
      WRITE (23,*) '307381323286279434907632338298807531952510190115738341879307021540891499348841&'
      WRITE (23,*) '675092447614606680822648001684774118537423454424371075390777449920695517027618&'
      WRITE (23,*) '386062613313845830007520449338265602976067371132007093287091274437470472306969&'
      WRITE (23,*) '772093101416928368190255151086574637721112523897844250569536967707854499699679&'
      WRITE (23,*) '468644549059879316368892300987931277361782154249992295763514822082698951936680&'
      WRITE (23,*) '331825288693984964651058209392398294887933203625094431173012381970684161403970&'
      WRITE (23,*) '198376793206832823764648042953118023287825098194558153017567173613320698112509&'
      WRITE (23,*) '961818815930416903515988885193458072738667385894228792284998920868058257492796&'
      WRITE (23,*) '104841984443634632449684875602336248270419786232090021609902353043699418491463&'
      WRITE (23,*) '140934317381436405462531520961836908887070167683964243781405927145635490613031&'
      WRITE (23,*) '072085103837505101157477041718986106873969655212671546889570350354021234078498&'
      WRITE (23,*) '193343210681701210056278802351930332247450158539047304199577770935036604169973&'
      WRITE (23,*) '297250886876966403555707162268447162560798826517871341951246652010305921236677&'
      WRITE (23,*) '194325278675398558944896970964097545918569563802363701621120477427228364896134&'
      WRITE (23,*) '225164450781824423529486363721417402388934412479635743702637552944483379980161&'
      WRITE (23,*) '254922785092577825620926226483262779333865664816277251640191059004916449982893&'
      WRITE (23,*) '150566047258027786318641551956532442586982946959308019152987211725563475463964&'
      WRITE (23,*) '479101459040905862984967912874068705048958586717479854667757573205681288459205&'
      WRITE (23,*) '413340539220001137863009455606881667400169842055804033637953764520304024322566&'
      WRITE (23,*) '135278369511778838638744396625322498506549958862342818997077332761717839280349&'
      WRITE (23,*) '465014345588970719425863987727547109629537415211151368350627526023264847287039&'
      WRITE (23,*) '207643100595841166120545297030236472549296669381151373227536450988890313602057&'
      WRITE (23,*) '248176585118063036442812314965507047510254465011727211555194866850800368532281&'
      WRITE (23,*) '831521960037356252794495158284188294787610852639813955990067376482922443752871&'
      WRITE (23,*) '846245780361929819713991475644882626039033814418232625150974827987779964373089&'
      WRITE (23,*) '970388867782271383605772978824125611907176639465070633045279546618550966661856&'
      WRITE (23,*) '647097113444740160704626215680717481877844371436988218559670959102596862002353&'
      WRITE (23,*) '718588748569652200050311734392073211390803293634479727355955277349071783793421&'
      WRITE (23,*) '637012050054513263835440001863239914907054797780566978533580489669062951194324&'
      WRITE (23,*) '730995876552368128590413832411607226029983305353708761389396391779574540161372&'
      WRITE (23,*) '236187893652605381558415871869255386061647798340254351284396129460352913325942&'
      WRITE (23,*) '794904337299085731580290958631382683291477116396337092400316894586360606458459&'
      WRITE (23,*) '251269946557248391865642097526850823075442545993769170419777800853627309417101&'
      WRITE (23,*) '634349076964237222943523661255725088147792231519747780605696725380171807763603&'
      WRITE (23,*) '462459278778465850656050780844211529697521890874019660906651803516501792504619&'
      WRITE (23,*) '501366585436632712549639908549144200014574760819302212066024330096412704894390&'
      WRITE (23,*) '397177195180699086998606636583232278709376502260149291011517177635944602023249&'
      WRITE (23,*) '300280401867723910288097866605651183260043688508817157238669842242201024950551&'
      WRITE (23,*) '881694803221002515426494639812873677658927688163598312477886520141174110913601&'
      WRITE (23,*) '164995076629077943646005851941998560162647907615321038727557126992518275687989&'
      WRITE (23,*) '302761761146162549356495903798045838182323368612016243736569846703785853305275&'
      WRITE (23,*) '833337939907521660692380533698879565137285593883499894707416181550125397064648&'
      WRITE (23,*) '171946708348197214488898790676503795903669672494992545279033729636162658976039&'
      WRITE (23,*) '498576741397359441023744329709355477982629614591442936451428617158587339746791&'
      WRITE (23,*) '897571211956187385783644758448423555581050025611492391518893099463428413936080&'
      WRITE (23,*) '383091662818811503715284967059741625628236092168075150177725387402564253470879&'
      WRITE (23,*) '089137291722828611515915683725241630772254406337875931059826760944203261924285&'
      WRITE (23,*) '317018781772960235413060672136046000389661093647095141417185777014180606443636&'
      WRITE (23,*) '815464440053316087783143174440811949422975599314011888683314832802706553833004&'
      WRITE (23,*) '693290115744147563139997221703804617092894579096271662260740718749975359212756&'
      WRITE (23,*) '084414737823303270330168237193648002173285734935947564334129943024850235732214&'
      WRITE (23,*) '597843282641421684878721673367010615094243456984401873312810107945127223737886&'
      WRITE (23,*) '126058165668053714396127888732527373890392890506865324138062796025930387727697&'
      WRITE (23,*) '783792868409325365880733988457218746021005311483351323850047827169376218004904&'
      WRITE (23,*) '795597959290591655470505777514308175112698985188408718564026035305583737832422&'
      WRITE (23,*) '924185625644255022672155980274012617971928047139600689163828665277009752767069&'
      WRITE (23,*) '777036439260224372841840883251848770472638440379530166905465937461619323840363&'
      WRITE (23,*) '893131364327137688841026811219891275223056256756254701725086349765367288605966&'
      WRITE (23,*) '752740868627407912856576996313789753034660616669804218267724560530660773899624&'
      WRITE (23,*) '218340859882071864682623215080288286359746839654358856685503773131296587975810&'
      WRITE (23,*) '501214916207656769950659715344763470320853215603674828608378656803073062657633&'
      WRITE (23,*) '469774295634643716709397193060876963495328846833613038829431040800296873869117&'
      WRITE (23,*) '066666146800015121143442256023874474325250769387077775193299942137277211258843&'
      WRITE (23,*) '608715834835626961661980572526612206797540621062080649882918454395301529982092&'
      WRITE (23,*) '503005498257043390553570168653120526495614857249257386206917403695213533732531&'
      WRITE (23,*) '666345466588597286659451136441370331393672118569553952108458407244323835586063&'
      WRITE (23,*) '106806964924851232632699514603596037297253198368423363904632136710116192821711&'
      WRITE (23,*) '150282801604488058802382031981493096369596735832742024988245684941273860566491&'
      WRITE (23,*) '352526706046234450549227581151709314921879592718001940968866986837037302200475&'
      WRITE (23,*) '314338181092708030017205935530520700706072233999463990571311587099635777359027&'
      WRITE (23,*) '196285061146514837526209565346713290025994397663114545902685898979115837093419&'
      WRITE (23,*) '370441155121920117164880566945938131183843765620627846310490346293950029458341&'
      WRITE (23,*) '164824114969758326011800731699437393506966295712410273239138741754923071862454&'
      WRITE (23,*) '543222039552735295240245903805744502892246886285336542213815722131163288112052&'
      WRITE (23,*) '146489805180092024719391710555390113943316681515828843687606961102505171007392&'
      WRITE (23,*) '762385553386272553538830960671644662370922646809671254061869502143176211668140&'
      WRITE (23,*) '097595281493907222601112681153108387317617323235263605838173151034595736538223&'
      WRITE (23,*) '534992935822836851007810884634349983518404451704270189381994243410090575376257&'
      WRITE (23,*) '767571118090088164183319201962623416288166521374717325477727783488774366518828&'
      WRITE (23,*) '752156685719506371936565390389449366421764003121527870222366463635755503565576&'
      WRITE (23,*) '948886549500270853923617105502131147413744106134445544192101336172996285694899&'
      WRITE (23,*) '193369184729478580729156088510396781959429833186480756083679551496636448965592&'
      WRITE (23,*) '948187851784038773326247051945050419847742014183947731202815886845707290544057&'
      WRITE (23,*) '510601285258056594703046836344592652552137008068752009593453607316226118728173&'
      WRITE (23,*) '928074623094685367823106097921599360019946237993434210687813497346959246469752&'
      WRITE (23,*) '506246958616909178573976595199392993995567542714654910456860702099012606818704&'
      WRITE (23,*) '984178079173924071945996323060254707901774527513186809982284730860766536866855&'
      WRITE (23,*) '516467702911336827563107223346726113705490795365834538637196235856312618387156&'
      WRITE (23,*) '774118738527722922594743373785695538456246801013905727871016512966636764451872&'
      WRITE (23,*) '465653730402443684140814488732957847348490003019477888020460324660842875351848&'
      WRITE (23,*) '364959195082888323206522128104190448047247949291342284951970022601310430062410&'
      WRITE (23,*) '717971502793433263407995960531446053230488528972917659876016667811937932372453&'
      WRITE (23,*) '857209607582277178483361613582612896226118129455927462767137794487586753657544&'
      WRITE (23,*) '861407611931125958512655759734573015333642630767985443385761715333462325270572&'
      WRITE (23,*) '005303988289499034259566232975782488735029259166825894456894655992658454762694&'
      WRITE (23,*) '528780516501720674785417887982276806536650641910973434528878338621726156269582&'
      WRITE (23,*) '654478205672987756426325321594294418039943217000090542650763095588465895171709&'
      WRITE (23,*) '147607437136893319469090981904501290307099566226620303182649365733698419555776&'
      WRITE (23,*) '963787624918852865686607600566025605445711337286840205574416030837052312242587&'
      WRITE (23,*) '223438854123179481388550075689381124935386318635287083799845692619981794523364&'
      WRITE (23,*) '087429591180747453419551420351726184200845509170845682368200897739455842679214&'
      WRITE (23,*) '273477560879644279202708312150156406341341617166448069815483764491573900121217&'
      WRITE (23,*) '041547872591998943825364950514771379399147205219529079396137621107238494290616&'
      WRITE (23,*) '357604596231253506068537651423115349665683715116604220796394466621163255157729&'
      WRITE (23,*) '070978473156278277598788136491951257483328793771571459091064841642678309949723&'
      WRITE (23,*) '674420175862269402159407924480541255360431317992696739157542419296607312393763&'
      WRITE (23,*) '542139230617876753958711436104089409966089471418340698362993675362621545247298&'
      WRITE (23,*) '464213752891079884381306095552622720837518629837066787224430195793793786072107&'
      WRITE (23,*) '254277289071732854874374355781966511716618330881129120245204048682200072344035&'
      WRITE (23,*) '025448202834254187884653602591506445271657700044521097735585897622655484941621&'
      WRITE (23,*) '714989532383421600114062950718490427789258552743035221396835679018076406042138&'
      WRITE (23,*) '307308774460170842688272261177180842664333651780002171903449234264266292261456&'
      WRITE (23,*) '004337383868335555343453004264818473989215627086095650629340405264943244261445&'
      WRITE (23,*) '665921291225648893569655009154306426134252668472594914314239398845432486327461&'
      WRITE (23,*) '842846655985332312210466259890141712103446084271616619001257195870793217569698&'
      WRITE (23,*) '544013397622096749454185407118446433946990162698351607848924514058940946395267&'
      WRITE (23,*) '807354579700307051163682519487701189764002827648414160587206184185297189154019&'
      WRITE (23,*) '688253289309149665345753571427318482016384644832499037886069008072709327673127&'
      WRITE (23,*) '581966563941148961716832980455139729506687604740915420428429993541025829113502&'
      WRITE (23,*) '241690769431668574242522509026939034814856451303069925199590436384028429267412&'
      WRITE (23,*) '573422447765584177886171737265462085498294498946787350929581652632072258992368&'
      WRITE (23,*) '768457017823038096567883112289305809140572610865884845873101658151167533327674&'
      WRITE (23,*) '887014829167419701512559782572707406431808601428149024146780472327597684269633&'
      WRITE (23,*) '935773542930186739439716388611764209004068663398856841681003872389214483176070&'
      WRITE (23,*) '116684503887212364367043314091155733280182977988736590916659612402021778558854&'
      WRITE (23,*) '876176161989370794380056663364884365089144805571039765214696027662583599051987&'
      WRITE (23,*) '042300179465536788567430285974600143785483237068701190078499404930918919181649&'
      WRITE (23,*) '327259774030074879681484882342932023012128032327460392219687528340516906974194&'
      WRITE (23,*) '257614673978110715464186273369091584973185011183960482533518748438923177292613&'
      WRITE (23,*) '543024932562896371361977285456622924461644497284597867711574125670307871885109&'
      WRITE (23,*) '336344480149675240618536569532074170533486782754827815415561966911055101472799&'
      WRITE (23,*) '040386897220465550833170782394808785990501947563108984124144672821865459971596&'
      WRITE (23,*) '639015641941751820935932616316888380132758752601460507676098392625726411120135&'
      WRITE (23,*) '288591317848299475682472564885533357279772205543568126302535748216585414000805&'
      WRITE (23,*) '314820697137262149755576051890481622376790414926742600071045922695314835188137&'
      WRITE (23,*) '463887104273544767623577933993970632396604969145303273887874557905934937772320&'
      WRITE (23,*) '142954803345000695256980935282887783710670585567749481373858630385762823040694&'
      WRITE (23,*) '005665340584887527005308832459182183494318049834199639981458773435863115940570&'
      WRITE (23,*) '443683515285383609442955964360676090221741896883548131643997437764158365242234&'
      WRITE (23,*) '642619597390455450680695232850751868719449064767791886720306418630751053512149&'
      WRITE (23,*) '851051207313846648717547518382979990189317751550639981016466414592102406838294&'
      WRITE (23,*) '603208535554058147159273220677567669213664081505900806952540610628536408293276&'
      WRITE (23,*) '621931939933861623836069111767785448236129326858199965239275488427435414402884&'
      WRITE (23,*) '536455595124735546139403154952097397051896240157976832639450633230452192645049&'
      WRITE (23,*) '651735466775699295718989690470902730288544945416699791992948038254980285946029&'
      WRITE (23,*) '052763145580316514066229171223429375806143993484914362107993576737317948964252&'
      WRITE (23,*) '488813720435579287511385856973381976083524423240466778020948399639946684833774&'
      WRITE (23,*) '706725483618848273000648319163826022110555221246733323184463005504481849916996&'
      WRITE (23,*) '622087746140216157021029603318588727333298779352570182393861244026868339555870&'
      WRITE (23,*) '607758169954398469568540671174444932479519572159419645863736126915526457574786&'
      WRITE (23,*) '985964242176592896862383506370433939811671397544736228625506803682664135541448&'
      WRITE (23,*) '048997721373174119199970017293907303350869020922519124447393278376156321810842&'
      WRITE (23,*) '898207706974138707053266117683698647741787180202729412982310888796831880854367&'
      WRITE (23,*) '327806879771659111654224453806625861711729498038248879986504061563975629936962&'
      WRITE (23,*) '809358189761491017145343556659542757064194408833816841111166200759787244137082&'
      WRITE (23,*) '333917886114708228657531078536674695018462140736493917366254937783014074302668&'
      WRITE (23,*) '422150335117736471853872324040421037907750266020114814935482228916663640782450&'
      WRITE (23,*) '166815341213505278578539332606110249802273093636740213515386431693015267460536&'
      WRITE (23,*) '064351732154701091440650878823636764236831187390937464232609021646365627553976&'
      WRITE (23,*) '834019482932795750624399645272578624400375983422050808935129023122475970644105&'
      WRITE (23,*) '678361870877172333555465482598906861201410107222465904008553798235253885171623&'
      WRITE (23,*) '518256518482203125214950700378300411216212126052726059944320443056274522916128&'
      WRITE (23,*) '891766814160639131235975350390320077529587392412476451850809163911459296071156&'
      WRITE (23,*) '344204347133544720981178461451077872399140606290228276664309264900592249810291&'
      WRITE (23,*) '068759434533858330391178747575977065953570979640012224092199031158229259667913&'
      WRITE (23,*) '153991561438070129260780197022589662923368154312499412259460023399472228171056&'
      WRITE (23,*) '603931877226800493833148980338548909468685130789292064242819174795866199944411&'
      WRITE (23,*) '196208730498064385006852620258432842085582338566936649849720817046135376163584&'
      WRITE (23,*) '015342840674118587581546514598270228676671855309311923340191286170613364873183&'
      WRITE (23,*) '197560812569460089402953094429119590295968563923037689976327462283900735457144&'
      WRITE (23,*) '596414108229285922239332836210192822937243590283003884445701383771632056518351&'
      WRITE (23,*) '970100115722010956997890484964453434612129224964732356126321951155701565824427&'
      WRITE (23,*) '661599326463155806672053127596948538057364208384918887095176052287817339462747&'
      WRITE (23,*) '644656858900936266123311152910816041524100214195937349786431661556732702792109&'
      WRITE (23,*) '593543055579732660554677963552005378304619540636971842916168582734122217145885&'
      WRITE (23,*) '870814274090248185446421774876925093328785670674677381226752831653559245204578&'
      WRITE (23,*) '070541352576903253522738963847495646255940378924925007624386893776475310102323&'
      WRITE (23,*) '746733771474581625530698032499033676455430305274561512961214585944432150749051&'
      WRITE (23,*) '491453950981001388737926379964873728396416897555132275962011838248650746985492&'
      WRITE (23,*) '038097691932606437608743209385602815642849756549307909733854185583515789409814&'
      WRITE (23,*) '007691892389063090542534883896831762904120212949167195811935791203162514344096&'
      WRITE (23,*) '503132835216728021372415947344095498316138322505486708172221475138425166790445&'
      WRITE (23,*) '416617303200820330902895488808516797258495813407132180533988828139346049850532&'
      WRITE (23,*) '340472595097214331492586604248511405819579711564191458842833000525684776874305&'
      WRITE (23,*) '916390494306871343118796189637475503362820939949343690321031976898112055595369&'
      WRITE (23,*) '465424704173323895394046035325396758354395350516720261647961347790912327995264&'
      WRITE (23,*) '929045151148307923369382166010702872651938143844844532639517394110131152502750&'
      WRITE (23,*) '465749343063766541866128915264446926222884366299462732467958736383501937142786&'
      WRITE (23,*) '471398054038215513463223702071533134887083174146591492406359493020921122052610&'
      WRITE (23,*) '312390682941345696785958518393491382340884274312419099152870804332809132993078&'
      WRITE (23,*) '936867127413922890033069995875921815297612482409116951587789964090352577345938&'
      WRITE (23,*) '248232053055567238095022266790439614231852991989181065554412477204508510210071&'
      WRITE (23,*) '522352342792531266930108270633942321762570076323139159349709946933241013908779&'
      WRITE (23,*) '161651226804414809765618979735043151396066913258379033748620836695475083280318&'
      WRITE (23,*) '786707751177525663963479259219733577949555498655214193398170268639987388347010&'
      WRITE (23,*) '255262052312317215254062571636771270010760912281528326508984359568975961038372&'
      WRITE (23,*) '157726831170734552250194121701541318793651818502020877326906133592182000762327&'
      WRITE (23,*) '269503283827391243828198170871168108951187896746707073377869592565542713340052&'
      WRITE (23,*) '326706040004348843432902760360498027862160749469654989210474443927871934536701&'
      WRITE (23,*) '798673920803845633723311983855862638008516345597194441994344624761123844617615&'
      WRITE (23,*) '736242015935078520825600604101556889899501732554337298073561699861101908472096&'
      WRITE (23,*) '600708320280569917042590103876928658336557728758684250492690370934262028022399&'
      WRITE (23,*) '861803400211320742198642917383679176232826444645756330336556777374808644109969&'
      WRITE (23,*) '141827774253417010988435853189339175934511574023847292909015468559163792696196&'
      WRITE (23,*) '841000676598399744972047287881831200233383298030567865480871476464512824264478&'
      WRITE (23,*) '216644266616732096012564794514827125671326697067367144617795643752391742928503&'
      WRITE (23,*) '987022583734069852309190464967260243411270345611114149835783901793499713790913&'
      WRITE (23,*) '696706497637127248466613279908254305449295528594932793818341607827091326680865&'
      WRITE (23,*) '655921102733746700132583428715240835661522165574998431236278287106649401564670&'
      WRITE (23,*) '141943713823863454729606978693335973109537126499416282656463708490580151538205&'
      WRITE (23,*) '338326511289504938566468752921135932220265681856418260827538790002407915892646&'
      WRITE (23,*) '028490894922299966167437731347776134150965262448332709343898412056926145108857&'
      WRITE (23,*) '812249139616912534202918139898683901335795857624435194008943955180554746554000&'
      WRITE (23,*) '051766240202825944828833811886381749594284892013520090951007864941868256009273&'
      WRITE (23,*) '977667585642598378587497776669563350170748579027248701370264203283965756348010&'
      WRITE (23,*) '818356182372177082236423186591595883669487322411726504487268392328453010991677&'
      WRITE (23,*) '518376831599821263237123854357312681202445175401852132663740538802901249728180&'
      WRITE (23,*) '895021553100673598184430429105288459323064725590442355960551978839325930339572&'
      WRITE (23,*) '934663055160430923785677229293537208416693134575284011873746854691620648991164&'
      WRITE (23,*) '726909428982971065606801805807843600461866223562874591385185904416250663222249&'
      WRITE (23,*) '561448724413813849763797102676020845531824111963927941069619465426480006761727&'
      WRITE (23,*) '618115630063644321116224837379105623611358836334550102286170517890440570419577&'
      WRITE (23,*) '859833348463317921904494652923021469259756566389965893747728751393377105569802&'
      WRITE (23,*) '455757436190501772466214587592374418657530064998056688376964229825501195065837&'
      WRITE (23,*) '843125232135309371235243969149662310110328243570065781487677299160941153954063&'
      WRITE (23,*) '362752423712935549926713485031578238899567545287915578420483105749330060197958&'
      WRITE (23,*) '207739558522807307048950936235550769837881926357141779338750216344391014187576&'
      WRITE (23,*) '711938914416277109602859415809719913429313295145924373636456473035037374538503&'
      WRITE (23,*) '489286113141638094752301745088784885645741275003353303416138096560043105860548&'
      WRITE (23,*) '355773946625033230034341587814634602169235079216111013148948281895391028916816&'
      WRITE (23,*) '328709309713184139815427678818067628650978085718262117003140003377301581536334&'
      WRITE (23,*) '149093237034703637513354537634521050370995452942055232078817449370937677056009&'
      WRITE (23,*) '306353645510913481627378204985657055608784211964039972344556458607689515569686&'
      WRITE (23,*) '899384896439195225232309703301037277227710870564912966121061494072782442033414&'
      WRITE (23,*) '057441446459968236966118878411656290355117839944070961772567164919790168195234&'
      WRITE (23,*) '523807446299877664824873753313018142763910519234685081979001796519907050490865&'
      WRITE (23,*) '237442841652776611425351538665162781316090964802801234493372427866930894827913&'
      WRITE (23,*) '465443931965254154829494577875758599482099181824522449312077768250830768282335&'
      WRITE (23,*) '001597040419199560509705364696473142448453825888112602753909548852639708652339&'
      WRITE (23,*) '052941829691802357120545328231809270356491743371932080628731303589640570873779&'
      WRITE (23,*) '967845174740515317401384878082881006046388936711640477755985481263907504747295&'
      WRITE (23,*) '012609419990373721246201677030517790352952793168766305099837441859803498821239&'
      WRITE (23,*) '340919805055103821539827677291373138006715339240126954586376422065097810852907&'
      WRITE (23,*) '639079727841301764553247527073788764069366420012194745702358295481365781809867&'
      WRITE (23,*) '944020220280822637957006755393575808086318932075864444206644691649334467698180&'
      WRITE (23,*) '811716568665213389686173592450920801465312529777966137198695916451869432324246&'
      WRITE (23,*) '404401672381978020728394418264502183131483366019384891972317817154372192103946&'
      WRITE (23,*) '638473715630226701801343515930442853848941825678870721238520597263859224934763&'
      WRITE (23,*) '623122188113706307506918260109689069251417142514218153491532129077723748506635&'
      WRITE (23,*) '489170892850760234351768218355008829647410655814882049239533702270536705630750&'
      WRITE (23,*) '317499788187009989251020178015601042277836283644323729779929935160925884515772&'
      WRITE (23,*) '055232896978333126427671291093993103773425910592303277652667641874842441076564&'
      WRITE (23,*) '447767097790392324958416348527735171981064673837142742974468992320406932506062&'
      WRITE (23,*) '834468937543016787815320616009057693404906146176607094380110915443261929000745&'
      WRITE (23,*) '209895959201159412324102274845482605404361871836330268992858623582145643879695'
      WRITE (23,*) ' '

      CLOSE(23)

      OPEN (23,FILE='TEMPFM')
      CALL FM_READ(23,M_D)
      CLOSE(23)

      MFM3 = ABS(M_A - M_D)
      CALL FM_ST2M(' 1.0E-20000 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3246
      WRITE (KWSAVE,"(/'     Check Log(2), Log(3), Log(5), Log(7), Log(67), Log(210).')")
      M_B = 2
      M_A = LOG(M_B)

      OPEN (23,FILE='TEMPFM')
      WRITE (23,*) '0.6931471805599453094172321214581765680755001343602552541206800094933936219696&'
      WRITE (23,*) '947156058633269964186875420014810205706857336855202357581305570326707516350759&'
      WRITE (23,*) '619307275708283714351903070386238916734711233501153644979552391204751726815749&'
      WRITE (23,*) '320651555247341395258829504530070953263666426541042391578149520437404303855008&'
      WRITE (23,*) '019441706416715186447128399681717845469570262716310645461502572074024816377733&'
      WRITE (23,*) '896385506952606683411372738737229289564935470257626520988596932019650585547647&'
      WRITE (23,*) '033067936544325476327449512504060694381471046899465062201677204245245296126879&'
      WRITE (23,*) '465461931651746813926725041038025462596568691441928716082938031727143677826548&'
      WRITE (23,*) '775664850856740776484514644399404614226031930967354025744460703080960850474866&'
      WRITE (23,*) '385231381816767514386674766478908814371419854942315199735488037516586127535291&'
      WRITE (23,*) '661000710535582498794147295092931138971559982056543928717000721808576102523688&'
      WRITE (23,*) '921324497138932037843935308877482597017155910708823683627589842589185353024363&'
      WRITE (23,*) '421436706118923678919237231467232172053401649256872747782344535347648114941864&'
      WRITE (23,*) '238677677440606956265737960086707625719918473402265146283790488306203306114463&'
      WRITE (23,*) '007371948900274364396500258093651944304119115060809487930678651588709006052034&'
      WRITE (23,*) '684297361938412896525565396860221941229242075743217574890977067526871158170511&'
      WRITE (23,*) '370091589426654785959648906530584602586683829400228330053820740056770530467870&'
      WRITE (23,*) '018416240441883323279838634900156312188956065055315127219939833203075140842609&'
      WRITE (23,*) '147900126516824344389357247278820548627155274187724300248979454019618723398086&'
      WRITE (23,*) '083166481149093066751933931289043164137068139777649817697486890388778999129650&'
      WRITE (23,*) '361927071088926410523092478391737350122984242049956893599220660220465494151061&'
      WRITE (23,*) '391878857442455775102068370308666194808964121868077902081815885800016881159730&'
      WRITE (23,*) '561866761991873952007667192145922367206025395954365416553112951759899400560003&'
      WRITE (23,*) '665135675690512459268257439464831683326249018038242408242314523061409638057007&'
      WRITE (23,*) '025513877026817851630690255137032340538021450190153740295099422629957796474271&'
      WRITE (23,*) '381573638017298739407042421799722669629799393127069357472404933865308797587216&'
      WRITE (23,*) '996451294464918837711567016785988049818388967841349383140140731664727653276359&'
      WRITE (23,*) '192335112333893387095132090592721854713289754707978913844454666761927028855334&'
      WRITE (23,*) '234298993218037691549733402675467588732367783429161918104301160916952655478597&'
      WRITE (23,*) '328917635455567428638774639871019124317542558883012067792102803412068797591430&'
      WRITE (23,*) '812833072303008834947057924965910058600123415617574132724659430684354652111350&'
      WRITE (23,*) '215443415399553818565227502214245664400062761833032064727257219751529082785684&'
      WRITE (23,*) '213207959886389672771195522188190466039570097747065126195052789322960889314056&'
      WRITE (23,*) '254334425523920620303439417773579455921259019925591148440242390125542590031295&'
      WRITE (23,*) '370519220615064345837878730020354144217857580132364516607099143831450049858966&'
      WRITE (23,*) '885772221486528821694181270488607589722032166631283783291567630749872985746389&'
      WRITE (23,*) '282693735098407780493950049339987626475507031622161390348452994249172483734061&'
      WRITE (23,*) '366226383493681116841670569252147513839306384553718626877973288955588716344297&'
      WRITE (23,*) '562447553923663694888778238901749810273565524050518547730619440524232212559024&'
      WRITE (23,*) '833082778888890596291197299545744156245124859268311260746797281638090250005655&'
      WRITE (23,*) '999146128332543581114048482060640824224792403855764762350311003242597091425011&'
      WRITE (23,*) '146155848306700125831821915347207474111940098355732728261442738213970704779562&'
      WRITE (23,*) '596705790230338480617134555536855375810657497344479225111965461618278960100685&'
      WRITE (23,*) '129653954796586637835224736245460935850360506784143911445231457780335917921127&'
      WRITE (23,*) '955705055554514387888188153519485934467246429498640506265184244753956637833734&'
      WRITE (23,*) '822075332944813064933603546101017746493267877167198612073968320123596077290246&'
      WRITE (23,*) '830459403130563776313240108042028543590269450940307400149339507673160285028697&'
      WRITE (23,*) '303187182399843352574354995608502566089783395564211494807339362607510238183314&'
      WRITE (23,*) '110047089039501343302974134748405406158775396888381540769801776730369991074924&'
      WRITE (23,*) '697847843128430364112892028012272563468391623354787727340063958657179819069358&'
      WRITE (23,*) '127387034335313189050383845616444442927969063837969092441303965600987663584627&'
      WRITE (23,*) '766076053486974908593811939309251791198855527765356660762439356877194233166642&'
      WRITE (23,*) '838200744816307865229235659826586275918747520875091447609016973569357231824249&'
      WRITE (23,*) '919475494431631463392270743244590302482544412490359409900711377326310998077723&'
      WRITE (23,*) '937579092667787226299567773759125268754691760395501473633737461645076457771598&'
      WRITE (23,*) '146610758399303043231349496586482284678495247540297968900151098424340816722641&'
      WRITE (23,*) '053465175318895709341462658913980173123676248874585502699619246678052425882378&'
      WRITE (23,*) '995907144185753559519019313826275593500184826081076906494067924435885831503526&'
      WRITE (23,*) '017045009346714087384727895167845415252267023696905468698446072109821774736606&'
      WRITE (23,*) '547523242089063817688335653308345429052023662173681689021810091859270116416256&'
      WRITE (23,*) '337109210919193811088408371995494139528087438476593315164645244837143495547071&'
      WRITE (23,*) '767478644667777773262400599442803883005052063960254487221940100482456835584914&'
      WRITE (23,*) '116372021650148290488954105485988582139146739280127960783765798030190197895831&'
      WRITE (23,*) '298445842350551628047138457098367143179598497983384936643051357439778464080283&'
      WRITE (23,*) '944996492836177201217529719601115189233475664664487214704005952700208247971196&'
      WRITE (23,*) '291259570791322875250242252752285663130430511219493771542940710492247147978154&'
      WRITE (23,*) '532985068822892694882234218141773477912289705930385167864412351277321379947051&'
      WRITE (23,*) '313086561526091767421412897899794277108410495559054929958460312928956410723379&'
      WRITE (23,*) '347221982629602465778859855649153542526276936457817157687505627695951940614769&'
      WRITE (23,*) '513362135896621103672390186183449100847056023240885740736498064913350497727229&'
      WRITE (23,*) '854121559922564905903204165800777130365484448790985802916806772298738484805391&'
      WRITE (23,*) '437126882845158996289290464953606976491322649729017581046490396601249026809144&'
      WRITE (23,*) '226696306532240532793180520138990302506701645946145093278991874975058845950892&'
      WRITE (23,*) '812313146535841156454786288876711792759444189103227033972699410782620949066939&'
      WRITE (23,*) '193233649528840398410534174131030284298298384597274509689153505229806232440923&'
      WRITE (23,*) '138110578435654734098675193838607282407897523799065221536828449641519520436143&'
      WRITE (23,*) '002340641177671720819470742812470616078679139714257561026877325672566518779398&'
      WRITE (23,*) '869543561247252503824110532837942494962425075385985566130187632566463726695281&'
      WRITE (23,*) '899182447028336064458337646946313432313914423530118060852644531774177829165319&'
      WRITE (23,*) '868877107483800215964071937546885362724120722736141210013984094390772718393471&'
      WRITE (23,*) '792022895741896562095677977039547595272233827891909436958956141581883760856034&'
      WRITE (23,*) '834063384906401173599284897189611655350881207229167416716902882811061704372980&'
      WRITE (23,*) '788755174869275740035755306007315351924334950734050193793931810588767452835236&'
      WRITE (23,*) '416527690371651749224459625244061326021533148024272969622677771345064205355151&'
      WRITE (23,*) '024831061088767266294511910945817001717135117299890025904644763066359724199051&'
      WRITE (23,*) '847024911088680124694191549654441175995933753867861532885105055485957519052829&'
      WRITE (23,*) '926745974805776695003496600239248911757605776389825650559728570971462382136461&'
      WRITE (23,*) '281575699631424743375953147095068089204461516870319405483113785049768421845778&'
      WRITE (23,*) '096360358356776814229804015130588032213887006143666466195154562642826797900580&'
      WRITE (23,*) '907023312944256272924492983069495929158131775714230468246948685772631408192667&'
      WRITE (23,*) '492977253974375636520310755620276511754740767284532831999750648553715678521340&'
      WRITE (23,*) '479205266153502615115035640625189174989835252957607118611897031987583795086582&'
      WRITE (23,*) '124471448554809890971322784110436163215054456189256415686480097687527172793631&'
      WRITE (23,*) '662356769343050705400960785297576973347816339786503563447596083113058918741088&'
      WRITE (23,*) '775476498966140767093540099289679033005197129229294655908813155093792311652676&'
      WRITE (23,*) '248200974255320501351088304034115018668628172784448518320999893113810480114847&'
      WRITE (23,*) '364338261550474827000102727871555379607626977726233061428597322037017716488013&'
      WRITE (23,*) '935906731651593131207225660010057306787815875968237327432664863152551632539069&'
      WRITE (23,*) '522055152460415473672664715829719759100176329246755391947924412596855986918431&'
      WRITE (23,*) '266716876066114774212493131547577111029905275698849479218285429200771991138110&'
      WRITE (23,*) '640201310850296702223726371927432520508605883939945814143535946600955513703685&'
      WRITE (23,*) '151439534425132251623274481769284748335160181431483775772910265977050216375513&'
      WRITE (23,*) '317616320906962102363852706627337362690153696255073610884241576308151549058618&'
      WRITE (23,*) '960450223864851723710305700902066826458514960037828134831228854708597775562195&'
      WRITE (23,*) '752286969914671954540310816696269690296896222715552668123003336549928427924612&'
      WRITE (23,*) '250395570999614692971694339351544508557516142866963351826393901192551987712707&'
      WRITE (23,*) '669409200410842997382985072562990345850433584478193617497687963688481517014603&'
      WRITE (23,*) '841493189458567310955889799384166616697431842151088678182747274771922062439778&'
      WRITE (23,*) '066084664630977888195315596103595567520455859572036591635522582959536734037782&'
      WRITE (23,*) '112409893988073073541836213121088375170380368236163604481832644531771086739357&'
      WRITE (23,*) '751041914220906966917822647476248726919802612861083744865233044185807437406799&'
      WRITE (23,*) '924659359146430681924558555771836314041797245925837265876930872766629910804504&'
      WRITE (23,*) '348591495996962501941052691904827629968903003602357636424254397670564582540996&'
      WRITE (23,*) '414041450994670345387743125702655292199608428211070672039110526250561980914926&'
      WRITE (23,*) '429443191308362902026158372172207479904166903500594072814160493965365572734122&'
      WRITE (23,*) '339332806103370037021008211534192227293534916762079885625851679806479158586942&'
      WRITE (23,*) '391146178726357859291357726649656033071530623284906061534893403415083718713352&'
      WRITE (23,*) '615870286424651827290435568456552106161725177136625005254799445985467661817786&'
      WRITE (23,*) '025877803806030984445445231764300573378558790455136113162544138851136958094835&'
      WRITE (23,*) '849584914934421251105356131748993037427322843117221670118781585253525367038010&'
      WRITE (23,*) '852035298366282616347129789683306531521000247432193921670599073133403022837905&'
      WRITE (23,*) '315374833325886025968671733006730262612955255637933976817300485239406795549141&'
      WRITE (23,*) '449465881533293253950529298238146676292254117063142342669344856493368632531418&'
      WRITE (23,*) '747139643415905283733805759990776658169381718971757458617472391097384196997646&'
      WRITE (23,*) '199589679391854451098059585787249716421848244964174409657751106908793193517216&'
      WRITE (23,*) '376221168703906403811218433433897183542006078817356825697886748930465585244588&'
      WRITE (23,*) '375921264841779920836375927805215882886594444347071772120467466371740330707609&'
      WRITE (23,*) '189137396956143477741839440991803548117653335878130833510705646029925695615913&'
      WRITE (23,*) '401856601359655560624421004911821699526092256929050668007880472190104275769399&'
      WRITE (23,*) '728857134943322807769849868922798926091978863997413490189574945776099003240778&'
      WRITE (23,*) '006385645141861828349003795405822520235575551835106442974343192288203124712092&'
      WRITE (23,*) '616672910059842425584688410737461252455480446810934156766289024463281824281667&'
      WRITE (23,*) '751184466668387823392709575081432194066411901596540674182811601761878924361886&'
      WRITE (23,*) '894263257092445908782154769142255960623010878593423021975662573657944763015485&'
      WRITE (23,*) '513301075928450951148704833843039530904701607204487468436180565560131594900674&'
      WRITE (23,*) '700028960122816580763957025938567028500857842913017993255346003026897124008215&'
      WRITE (23,*) '372023295239510561612930218011086117806018705258023174799663311973159164227394&'
      WRITE (23,*) '841457146006097721028175934997957626572830726924318064900431093352977471930292&'
      WRITE (23,*) '569559289495918975229282504936734700072201870074852517098129533228990355643489&'
      WRITE (23,*) '282628242232057765900906768264520455193008656009268487634941672172576245498392&'
      WRITE (23,*) '407482176816497950651016496723435321271361477358100054703859727717522533474044&'
      WRITE (23,*) '249181355078831786228920823407840877579510977437116659105850764539512808885418&'
      WRITE (23,*) '022379717921945595784992041975424078230570210176927234282010614401413727798996&'
      WRITE (23,*) '550879570794358959247496352560292741940328341730785362188088484884799858368585&'
      WRITE (23,*) '337653864695945882672064068254838713940288325003451919161457260171375712977479&'
      WRITE (23,*) '435196876679368319244207888906419429844415672325841374317637258025122604023769&'
      WRITE (23,*) '343179405756465733037696140228131154458232717946132934232405660541738351556403&'
      WRITE (23,*) '914350759765683127548780879337234275773964980299053868070184720497233498754739&'
      WRITE (23,*) '340050533341342018905605212118300171227373591923255203966692629440419692461864&'
      WRITE (23,*) '806559658635288700740509857416169814414722985619578650467769499339468429459869&'
      WRITE (23,*) '106118001009042268417154368150887488240992364668208089623232784652772211168408&'
      WRITE (23,*) '287961422245525960470524628437332840413975391008488717787008112139990501571208&'
      WRITE (23,*) '280239163476825573196776728313491684598803977575948199678642710110156272292748&'
      WRITE (23,*) '732594889442671553838722227514802964942565556051884833321343658624931151921363&'
      WRITE (23,*) '915359415642413254753582033416070833779730918726398256508185286720245988893164&'
      WRITE (23,*) '249212530407153426697072877570175804894613052403378088812972108852604371672274&'
      WRITE (23,*) '967332353434642467120451903645790546924095235594038258781454763009236599377894&'
      WRITE (23,*) '412438658640316333822515478766272608083042113492131163014656656320074508321431&'
      WRITE (23,*) '381965210841370168986972635800970990044851495896303448419575981412854012310025&'
      WRITE (23,*) '933759297634281315332791919047911211651153793224396272984317551311793589979853&'
      WRITE (23,*) '693269565212094191537325792386496150810656167157629833046992088363312424889758&'
      WRITE (23,*) '525953688090251145094432756591875081992544654411784477740288025906346075632310&'
      WRITE (23,*) '858426359523457417012715892220587058899637637700201493553990253400623191011562&'
      WRITE (23,*) '528723490697031663038643406091912041616889152649702438145299217404069064338640&'
      WRITE (23,*) '559104931198053653342195008311499067586544440545526765576180764743373734064815&'
      WRITE (23,*) '235781279478780956494237019281071623324416630911647165798208522239041063104215&'
      WRITE (23,*) '698032582804964253399466616672746040254355480868315362056923400100423986025698&'
      WRITE (23,*) '467250021124138680228087893332985646757172111567270640693544228725331084446397&'
      WRITE (23,*) '104974574059697743620202440233273612136610625085166691808445362008089431816852&'
      WRITE (23,*) '479359277006042538251416630259933877186540095290348691984922362267860461826523&'
      WRITE (23,*) '305506533662724242441599040006264429245027117749751058800901102369308452550080&'
      WRITE (23,*) '211544364427280158034662741766977570165341861124949007018306143765679783472419&'
      WRITE (23,*) '453887027732527900748672865957868021017973871377362988158466334928962783513688&'
      WRITE (23,*) '345611583327020534023438300223066913124184305891183389197339745779270739534707&'
      WRITE (23,*) '126617952861559133100593695296878122473471579181576543740246461624335699859076&'
      WRITE (23,*) '753805517136646893108143543774283925562105977372172810726742898104273804152580&'
      WRITE (23,*) '081773133784859429235960604583596487232303931417919480615333084075258421225607&'
      WRITE (23,*) '767479765644924882294350828226147663841867094048278801509469765315263015187266&'
      WRITE (23,*) '437879038301847531225325420919317880966099568182573525240553808977936943311802&'
      WRITE (23,*) '588814056976010202324216404096374046464376918304630891475066889343894084702565&'
      WRITE (23,*) '935263806825509811469960411623414634018408838321947545604618104422960857833092&'
      WRITE (23,*) '306851490272393723761954136292093920175118228051530692405081825542630944007267&'
      WRITE (23,*) '416954698029023078900860453460826581214148446478797525613747654053978734198146&'
      WRITE (23,*) '860216965561755497250023505993275248957407954232317530750092603476619972768070&'
      WRITE (23,*) '032047533370473467328439804039405716913529858762866701036116715506898942833637&'
      WRITE (23,*) '141140418216923040188689178737550545168916737470686006980000282449782273663432&'
      WRITE (23,*) '552805797701120201107883715162750513241064466983899916686377154539622990883951&'
      WRITE (23,*) '271522926030593920003955823121075102290068158630782863974779164036905708369743&'
      WRITE (23,*) '129569566940164985010306936406846624101034391769743705076068231298226004325971&'
      WRITE (23,*) '317084295352276808221024703939416253606037544035026060229112082081025023581821&'
      WRITE (23,*) '129987736015934782065781276743622627826835724196830736602751972162951889534395&'
      WRITE (23,*) '917126744281802593685272867478484936755156101581954743960006449859992186273618&'
      WRITE (23,*) '785817726127631336301327815132881873412871642373064699995041163514096205237165&'
      WRITE (23,*) '911935270250308690354160085082691930707276856721456533228130168939431818566797&'
      WRITE (23,*) '033938345851290322041618163125740038906357505769659102091267340545301143049444&'
      WRITE (23,*) '614104858846561912054552111606392843100583387285194766872975902790920278412314&'
      WRITE (23,*) '457252155664691604989082199110139757624706042071130634370008155159995551253456&'
      WRITE (23,*) '920247658332824051856025433417188975510224802014995161645411507938197123181463&'
      WRITE (23,*) '963702452885601353041672957625871641247056324166759160152642145622488747003540&'
      WRITE (23,*) '092591100005865867318249233360718312357637050214018122389271887844122136288575&'
      WRITE (23,*) '168652193703146873591117127044078390618531174915462959689817446390557606621449&'
      WRITE (23,*) '420329170926217376784883044883211654785912424632159264242645517191882136591919&'
      WRITE (23,*) '900377208242856696453471768051000099749458163392820899417845951685120001619506&'
      WRITE (23,*) '777574719957593746204451088185986562215766412598200226570198460052565084324939&'
      WRITE (23,*) '180046663499825296554670789247803018398097474759584883543366554421452824192750&'
      WRITE (23,*) '124080998884672818618586164065627792571353909525264631905379913198376247313068&'
      WRITE (23,*) '947524083131834089163840272767273267098315937965928168271143427380826180019787&'
      WRITE (23,*) '884600049552677941945098336467275015242943702968036743337553496485766934520879&'
      WRITE (23,*) '771145765334677566709638315282133033209889522508981407459378944577345158259447&'
      WRITE (23,*) '515688368522256284007761327503621781030812333068818583391347164473216749381088&'
      WRITE (23,*) '666691597844715443529110164548463574609091489248612816466537904545591507913147&'
      WRITE (23,*) '761892139930495393239749330876048423130834623902651461567414703580782553246566&'
      WRITE (23,*) '486434874911307854563828698991865076045255838092772245367152839530633413563356&'
      WRITE (23,*) '542310979716459960960007619351564079754200264687866504315750108385392281759274&'
      WRITE (23,*) '900929804050787604887604628973293899407529218395937228165492494944500019534700&'
      WRITE (23,*) '761278803198692038093973991194107767525346926500939428975102843414749825151872&'
      WRITE (23,*) '946421918487665158967372771274297341998019946019438696838255263005087356912247&'
      WRITE (23,*) '641192393079988022858184940197806297464094954612478287966829561928690339627912&'
      WRITE (23,*) '574967886785655042109319397366941380547810583011047010435230462764167893031910&'
      WRITE (23,*) '207359846336243287303993154709590172820488710333204481925112905655964161311788&'
      WRITE (23,*) '378634299697909994274941351385737158433151895234591262273735109075028134152218&'
      WRITE (23,*) '302688728907775366751152294121468330309518152884439224524998553016047205803522&'
      WRITE (23,*) '460998929568993257235646487973064080220024856707292221773724911976210468641629&'
      WRITE (23,*) '521543244142051646155484468613792478959226650854773002664364187074726857942282&'
      WRITE (23,*) '935751850073370936752589886275958415717755784139040719310806922047312226677190&'
      WRITE (23,*) '620165318855393019570054661874711652912138755169988027430015934323446098000676&'
      WRITE (23,*) '400623843311760284184391128104303937479510931875446903800771950686147901864503&'
      WRITE (23,*) '363056387831731184990877565044863458724625931590482674513307154046623042446124&'
      WRITE (23,*) '272439904600215209964195068037794626189992065951873798058407264947939827589080&'
      WRITE (23,*) '610898665326393664941582799186756935414618363260233108770326987139698120407653&'
      WRITE (23,*) '859957379413882787345639285609402277258216672336686576695886036246235122928615&'
      WRITE (23,*) '412051509045380792266925458691896396232072034476855179352351288772388243509337&'
      WRITE (23,*) '000754944664093389634034755051661406302699453047835611035199340946104642461025&'
      WRITE (23,*) '824111820379394639578957121668490888559732460031177437969435909771616396216117&'
      WRITE (23,*) '755188044260634338239018031526955238118867765850725491463280737814169323131469&'
      WRITE (23,*) '109444413937664846470379004840831805788393454869589311180786268676096704068766&'
      WRITE (23,*) '305023415418310566608471857543757426265983635139073767185709006978698842294398&'
      WRITE (23,*) '120281764925956354017847038834654121912245309961274037942967060213091432022068&'
      WRITE (23,*) '614361477897473674427567693258339857090020844536950201722460980736775091201696&'
      WRITE (23,*) '482074144206900588581719036435890430564406003653468590067233453880358720372724&'
      WRITE (23,*) '097476778174618964820860428368910069677322537717172160299780147208048636577509&'
      WRITE (23,*) '665348544549598262014635961572716389345014441492589540835574327007328970026796&'
      WRITE (23,*) '851865802043388098019472204460535896808575027859112962945895986707529487554872&'
      WRITE (23,*) '235838935015908422997545797018527177956789446793534815737471015864869972913691&'
      WRITE (23,*) '572090259416475756389132512233708259586838313298999281228892760606078478127710&'
      WRITE (23,*) '891145352839610116212636161688431253109210709186283497912255076635165999593169&'
      WRITE (23,*) '704977711977406971288722245125223223809106822929666346914169055128202110715779&'
      WRITE (23,*) '569167560822156369398784196518905798504343303702754344619686372330942805815233&'
      WRITE (23,*) '930222808443506855274130809379037598213658647503762684939516823532922411168920&'
      WRITE (23,*) '434261864850031034553080867963692228656723068230485076186919914410898023337277&'
      WRITE (23,*) '956720903640144511111030957406334462771411114006130763032289021515791529050163&'
      WRITE (23,*) '165573831884562233671273602181606394491261104358122549777977198552819948058457&'
      WRITE (23,*) '838182549975440860697587927338329384262981250614639994817940997240072869868911&'
      WRITE (23,*) '959391225257870072184440647375024269589787634968994668737325254644539065775853&'
      WRITE (23,*) '861158772880656847118345375383620387665431658137988905944684874821918506088949&'
      WRITE (23,*) '374057984196397697758541669020632215525498569993267223022378991719308474629769&'
      WRITE (23,*) '012506235521362020143037786353965565176471344675829919255719245594297291688229'
      WRITE (23,*) ' '

      CLOSE(23)

      OPEN (23,FILE='TEMPFM')
      CALL FM_READ(23,M_D)
      CLOSE(23)

      MFM3 = ABS(M_A - M_D)
      CALL FM_ST2M(' 1.0E-20000 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3247
      M_B = 210
      M_A = LOG(M_B)

      OPEN (23,FILE='TEMPFM')

      WRITE (23,*) '5.3471075307174686805185894350500696418856767760333836162274123845426467656480&'
      WRITE (23,*) '307148972714584912019141229995073140952552875012819486911134208680473350299598&'
      WRITE (23,*) '759938944456132108314054329426790615328446410493306148410216100155673570446624&'
      WRITE (23,*) '949689221931990308910554350186810265492926596135273618307471108831156136086824&'
      WRITE (23,*) '797160007936597929410664834955387113963548474566930592007540118798913177786496&'
      WRITE (23,*) '039125662746398050678220767788319996787197487073826205036235318427814765931139&'
      WRITE (23,*) '394039619044397484568889920939594262377936851857423397335114669801462283244000&'
      WRITE (23,*) '999701031510390640962586127325978728993498571548644260069976648382677928238460&'
      WRITE (23,*) '597615336857746767338199962152387599684256535649397273530686830180968014792871&'
      WRITE (23,*) '160963214619660048655871515771203314220510574017864638506138136542303951557722&'
      WRITE (23,*) '442053924608246827279527147948373343589666596845406316375070544200835901425341&'
      WRITE (23,*) '818395215561263134034238011854448395881597825460836617286096885955472042012596&'
      WRITE (23,*) '578754994469834231372042944798072269779458383701266766499447583432069287529536&'
      WRITE (23,*) '200179476602214146557020795648663925301213053812155645778710900479618814635873&'
      WRITE (23,*) '532415926861487009547019528647166990952348298302817197606437657199880674077442&'
      WRITE (23,*) '748057372110622123520003548264232662981836861917767878186268042092381481836467&'
      WRITE (23,*) '015219159911947960525971523552501924273459347635291675881814675826887462005049&'
      WRITE (23,*) '215110588283277414905978580998920255838396918365249686677831400945045156644611&'
      WRITE (23,*) '012523381205698982967361671687439618977738794618623117790432027547181861593343&'
      WRITE (23,*) '703427920040602516417396420897466037015963210871104639487638335054071018054778&'
      WRITE (23,*) '395523198071002205188341979522601480197498465626485154911718405192883150463134&'
      WRITE (23,*) '571514989709113309383668666923415532191782849487251137577532187837982454362930&'
      WRITE (23,*) '773061003836201513743527353666896553054915378957691183941568067093354386969933&'
      WRITE (23,*) '886578087140250587369691295113596563996385728714102034325502854729338097343876&'
      WRITE (23,*) '616032468021337031266889530945519605890835789845713114488851026388110271769915&'
      WRITE (23,*) '937235697176957909346060593961592980745311171679725241332250406390314829648117&'
      WRITE (23,*) '230862099453767017019288615819478422880023635732478780658425644657083843495524&'
      WRITE (23,*) '955461790866497992906123454606231050915288062405943399509867556556156972959752&'
      WRITE (23,*) '640903861385324659163690746330953844623495200040837712910105810185029265853697&'
      WRITE (23,*) '746071719059065916112009063724841892129959997070586842054466054651060330744121&'
      WRITE (23,*) '003161470188482389833398656569249045562692828777681021404118550759758672192094&'
      WRITE (23,*) '746174547151516733011604431958177196186317929405269060073655003779188927042962&'
      WRITE (23,*) '253639026708675849584393894975796070242872367005948646169894801759937995234448&'
      WRITE (23,*) '329819906556077590789193675238840423827318414289301567410277401371097668148077&'
      WRITE (23,*) '179697399222153343370825959635286344021677768301991714701702295775368625903461&'
      WRITE (23,*) '621640486463586461910481002512527870092431408414069791711502440248478885405088&'
      WRITE (23,*) '875749151455833825387934831137699459084137814357069498886215276518451739796797&'
      WRITE (23,*) '598844392305356054490857085863861001281660463321400234300413271461046325347593&'
      WRITE (23,*) '540207090238020861728281537872408747807263236337275484667859467576407646598431&'
      WRITE (23,*) '829535294895087132663643727262384641975253107897443246652212909079817525378944&'
      WRITE (23,*) '584838347654841204033180901289124696459989118696243768873790880319943708034610&'
      WRITE (23,*) '927429043348886621326308254588534718864319597446244937841292890814716339291639&'
      WRITE (23,*) '423746823222946980030162436866968411149283536312941485809555753678817961966876&'
      WRITE (23,*) '133467715143887024611084476919490066272716737951260302253108012697641025812874&'
      WRITE (23,*) '605963792185864066110230785091287623030139326601051985600532572974724718695990&'
      WRITE (23,*) '067229379524689075686982728789117415434365154435526709044237664942880946163818&'
      WRITE (23,*) '471845838613734809548056029563259155392731493035057935345243005548993550227077&'
      WRITE (23,*) '706488272873024409739310548595366789487180551603134067586921964806184562916142&'
      WRITE (23,*) '769252121705389588544566597431524876834585743201249656197268352195574225397362&'
      WRITE (23,*) '913176864091967885982209381149386358140324626505253250754423632696076747286033&'
      WRITE (23,*) '115380724368929907879953447635625108362067582708236114838282729891705563121030&'
      WRITE (23,*) '815064349930475064539622444200557943709122494717645402312387894707931482893514&'
      WRITE (23,*) '639371918991450294428555573783858067831990037501460488077694764369574172639754&'
      WRITE (23,*) '472828989086763319559557308256991783063916662357770468880360075729827341453023&'
      WRITE (23,*) '080331477621556842396451757764323647319852364567451024275006049958439502679798&'
      WRITE (23,*) '312244893612762134296774818666825912204779627269838252581157947346034227797642&'
      WRITE (23,*) '215240647229214741727605013072966809935412883940765705740320917840695187947676&'
      WRITE (23,*) '951839938794125960946869435869913034458776841094979797477940400548931421205974&'
      WRITE (23,*) '492887085893288387357630820894269195370093156017368672357311794137876453577617&'
      WRITE (23,*) '616102935897543807348825758399277502137921392988675807232767944040186497186948&'
      WRITE (23,*) '736625959486156896402349297847280508173410549304611760249005013052357132622113&'
      WRITE (23,*) '130277324125294187344369193452451206955279256138476798869270578791334957460122&'
      WRITE (23,*) '789826854004312315802202783912395656486696662394611166584652247442384399265085&'
      WRITE (23,*) '724242010186654849732716352809509893199369472000851492041342603571926908916109&'
      WRITE (23,*) '420812443847963976046009800277325233633119871311735720385266840774645103160391&'
      WRITE (23,*) '428057912373652963499816267517217343098823201310685722371166550284893692966294&'
      WRITE (23,*) '355337785233923799089805925077003021951063983805636329418340104204982434241324&'
      WRITE (23,*) '004194810773456395608540502314877333467473081302185683716540544871526171742831&'
      WRITE (23,*) '910219742395362804171402667165598633864576760699860470224528810221735876138415&'
      WRITE (23,*) '280126947205465367777166629326253211337381133881806027527429096443520505812608&'
      WRITE (23,*) '118159933629941445845319588234880091892479558419072458655844389920414240496699&'
      WRITE (23,*) '496480478946167255226957997545460718529382214825336734033937643298078198859627&'
      WRITE (23,*) '233288596280916012270332757946801214432836830170877773518549024303389448239832&'
      WRITE (23,*) '435308768458448796471069090866032118494771656273096374807162878803395715244516&'
      WRITE (23,*) '003912474658278933053729457611486916400369754655069750912170229271733600135742&'
      WRITE (23,*) '979896710865641509792060783332724128673874679462009763415077252312784149315895&'
      WRITE (23,*) '165606598773945587310999797347245745019917679549340140492975832185933614791257&'
      WRITE (23,*) '320353071232331196208708762878647897907936171544480609889348913735295160055605&'
      WRITE (23,*) '094314204929873277883725221720484614501824136338539685836756501983727492484453&'
      WRITE (23,*) '369182604480644806618751997560139873084895437288376251418538326773299303395890&'
      WRITE (23,*) '750060639322764533079457987193321813346115833929500669914979066909499822288982&'
      WRITE (23,*) '122838421024139624528464466135041784918985811594084678846367874384614146808510&'
      WRITE (23,*) '372267696348577714408616375408448559656747241171950005303137480413896506524746&'
      WRITE (23,*) '137379213578027065437577099142354247482931746805184124833841617397991065109627&'
      WRITE (23,*) '731162526205485885378335140728662572414027927994537877462702867518528466495870&'
      WRITE (23,*) '719754447641672101228030152997797221808723913013353821710885709767955624926747&'
      WRITE (23,*) '761891948248675666889441375453840432183113795045840781907605792619152724519135&'
      WRITE (23,*) '283787512404246897562210442854577397150488385458451388994731519116194915545485&'
      WRITE (23,*) '488587120074467009915947625709965694189747636857842288148602154137229217476765&'
      WRITE (23,*) '768170147831549524370170205098640339242013886322013725401724369019644591686403&'
      WRITE (23,*) '929650536353272072833146093383380368973853333991010043029304461280886816785572&'
      WRITE (23,*) '909352923815353073854071980948189689124787013909847625370627206846777186620261&'
      WRITE (23,*) '407340546636502405034779637755851747198619190961218341869458298941846177887862&'
      WRITE (23,*) '988867264539538152764060622930302524085303515515044909802144272168096212263925&'
      WRITE (23,*) '249159526699494976654265594601729566394081179652281572240869454246104075378661&'
      WRITE (23,*) '088953392714084658072452859815204748734601712264172071415904555186384640815047&'
      WRITE (23,*) '875081943013083985542398605586141559020470983584689762287058142094069547175134&'
      WRITE (23,*) '375026501044801978118638546237017371850324399265400849395117948704023980591639&'
      WRITE (23,*) '837410114958871175452468895660872687020943025694723018986588855770819797081383&'
      WRITE (23,*) '748924786240887974820156177649432235554529508140430366051118026996680303559548&'
      WRITE (23,*) '546978300522161411588370025735020672749969375531580461004442074754291832724247&'
      WRITE (23,*) '510359915825235330151719430758253393394700573472704260684506291220460824767241&'
      WRITE (23,*) '578874856066065914223618828040994336333356157217995177601768960184550715264533&'
      WRITE (23,*) '214513706936987653666002954279758220637367885553080533665943524031234106894287&'
      WRITE (23,*) '566898332561283422644339890047615402750076427135922226915098612006760050288842&'
      WRITE (23,*) '579874043710081395838392841161843368811204870945490617092282518248113493603923&'
      WRITE (23,*) '180754156168653911304199464960664305467487522301602402601911862682082013951949&'
      WRITE (23,*) '533853023564936407161906796050432481184073888509397950096071551141411068352268&'
      WRITE (23,*) '116618577707422173670205473995257503098025884540930868066626473128666306685966&'
      WRITE (23,*) '898613615669614752442186563275034992200059373800611316082008798883377493596799&'
      WRITE (23,*) '932246951830600559710602624445172678221728200261964958853748262926900354453060&'
      WRITE (23,*) '483397137769265604978636876957756380090650869601710387318938730026017082804258&'
      WRITE (23,*) '418539482698373357004614087954113269680713075307719229669006257777552692742220&'
      WRITE (23,*) '663443869979995668291921621461821955112717126834162255366562991820409810421159&'
      WRITE (23,*) '991227445394346466334328097508301579886736139460038182218501983464812393314737&'
      WRITE (23,*) '280097185248201510578530880158660764991069110835500715374961731912219410605175&'
      WRITE (23,*) '035305902864684278899782809779596634672613106373540856087074548428881288511720&'
      WRITE (23,*) '921616675345894930062163695687633704577597378431689125876055897319072607015644&'
      WRITE (23,*) '252974994511948910815393087240716567828049093613658133003820904927362700629154&'
      WRITE (23,*) '851372641591703653177743044764713301191499173986857474679367292220938748307417&'
      WRITE (23,*) '266135407198156240919435873179220363805132665076573859650213136608631752792115&'
      WRITE (23,*) '974261193902478868055002155312959709759625071731569242417847099469416112649732&'
      WRITE (23,*) '782237897499104831662268338897529194931257167034362412949053115187376299798773&'
      WRITE (23,*) '123312274739753184181713606011451610825028740106546531862933315578884178397209&'
      WRITE (23,*) '344797854065696254193880320250830393820828143598514410161542301956339869411758&'
      WRITE (23,*) '025834059235471060512198683763249245229776138508607797653425532873165976792168&'
      WRITE (23,*) '665571624433425287169354033054251149972297393946955971599274774305704909186439&'
      WRITE (23,*) '330756401271815676535330709307295162882090989307779427430277628434343572029380&'
      WRITE (23,*) '096517768213149694713584735787715656227878605945719328798277358331607262543193&'
      WRITE (23,*) '883584009833226682482118129988539716829631262778352852373760814858023241898269&'
      WRITE (23,*) '911415193978655330829848731862844199770510729615449684962375224976283380754728&'
      WRITE (23,*) '042973511506428524300445675964134185293699369015188238624721907300818584227374&'
      WRITE (23,*) '777088125253455589231202401885928832455397604937681186281072457908235704490463&'
      WRITE (23,*) '755259518688352472597470108144709968883396036692410095507875206820222317448689&'
      WRITE (23,*) '394119768719462085851793086568425291989991433699161597810498514363701248938252&'
      WRITE (23,*) '391796802960373831897728074075335554434059383459478690556840615216334519921328&'
      WRITE (23,*) '847462782201938825235040503553403271587650342030084774675990571109712136804600&'
      WRITE (23,*) '490048389193729648347889389315283528202685476139102773481485110936805030668536&'
      WRITE (23,*) '195177735989051209162223631220052129679335721725535815566360618539165745869711&'
      WRITE (23,*) '704886099695131188293219682923965483061092237415228418659905906219227592065892&'
      WRITE (23,*) '992452573446424266010864096253326630676245374788209316366963279982025006846157&'
      WRITE (23,*) '618930025044614098534267122518124707888224799530597844556640334554434294553269&'
      WRITE (23,*) '952127551033916434417740200227758903175610758794397929245339252987141176652898&'
      WRITE (23,*) '817384620704082863976888695111277689749761401839864444411455805360400541333158&'
      WRITE (23,*) '941733140420613198842024981149360771661214236145092499352959832883333395731868&'
      WRITE (23,*) '669245571175828281142671073797751968542650533059210781271523793377425653363204&'
      WRITE (23,*) '905981733176763296263962691600680926815728131164864762036845106509989441971241&'
      WRITE (23,*) '779457332665051137213150877648081898044435203694071889951113481017998239039440&'
      WRITE (23,*) '286738543343289754968046651033380616040155678033091579635301104515953792336577&'
      WRITE (23,*) '822964030943587254157277614805834355996803749603968952832118792967700889870693&'
      WRITE (23,*) '018661862258240319610180478264792375118287973207818376914806329813521323680744&'
      WRITE (23,*) '416856152251387784739573493643444537103045001592388295484453557990955686977775&'
      WRITE (23,*) '710556964521851917070756551228876797823796292341177153452664031084369693854260&'
      WRITE (23,*) '499640662081834940714346344266809738560530256797756478103247520051612537292985&'
      WRITE (23,*) '259608693987743916025731539510088033116561507894488895128945775979456919579952&'
      WRITE (23,*) '378869811272689265743763052899065498427879170577895892579920468496464019380100&'
      WRITE (23,*) '870018533226751157307574831252117281607432732008955420266435797483527996569375&'
      WRITE (23,*) '007930899835501809829035459490068201562612284926590873334005390007391493066247&'
      WRITE (23,*) '848948382170596039441601236103271986908121164118465972829687017550833344102043&'
      WRITE (23,*) '546144647329334245524384998288665082763573680050303765936242131063242207105532&'
      WRITE (23,*) '043872874228480164947773560598713537642130363854648270717923123560136316829250&'
      WRITE (23,*) '826620963840675088863262369691723291923461560733314301771688685523444598439963&'
      WRITE (23,*) '627308744997649888559184611023374100227245908337127778431849033892938356317292&'
      WRITE (23,*) '991623987117253261487225980139146922594974353540551522144569828658274214785395&'
      WRITE (23,*) '625944373184350824969334837658616869130707069402373370141529810786756690803236&'
      WRITE (23,*) '836405497316895937628979977465771229083180944417211542632360649641006410644685&'
      WRITE (23,*) '316614568719485321640427770901423967181422838804532864088585216249450964722172&'
      WRITE (23,*) '972828680848126959353580400461745101013216684661966504128323716897350424535496&'
      WRITE (23,*) '934790749561896596840521950232058932133428598317677483113143581048593147761446&'
      WRITE (23,*) '149949068811789158186472909589212170397912070820662362779681164178406666371219&'
      WRITE (23,*) '267728091141817774129897654527928548833077805443268935271440089114880349761855&'
      WRITE (23,*) '344546350300223272036153047033775362433283270726576658437986609696961218729797&'
      WRITE (23,*) '661359738925217842893083452417618564146881018156290873235910882124964944262657&'
      WRITE (23,*) '880504037515993707248524946179392725390677697330150886525253015648129541087975&'
      WRITE (23,*) '637050436929188714887047112174338199131092487160612810221726545710547786548809&'
      WRITE (23,*) '962091566933945463585198619355062220101415144013564330532689782380256144365732&'
      WRITE (23,*) '542596249242989787645692230895696602698048107257433539731593199260195582308662&'
      WRITE (23,*) '168711805024694012176363411592802095640924796576282591633168518210460788993464&'
      WRITE (23,*) '986619085241088132861520209149380840356661205155888825493271126326641617266593&'
      WRITE (23,*) '227171525629830252089394647242335316083877024621014676322447434429721309759102&'
      WRITE (23,*) '655403863800038690464794467763990283227896767573449531079554152158402533987760&'
      WRITE (23,*) '251698945342056604657422447437106976889327630844386693725090350845657032979292&'
      WRITE (23,*) '752766537509082585440366832527891386580178015257183898564970128491297222854891&'
      WRITE (23,*) '240037322759437108002377561658278728372357394790903608815708280093766914100141&'
      WRITE (23,*) '002966863283815874803145083394817833041840778180876000142283337695728912751839&'
      WRITE (23,*) '442940732055606221572066659099561979816586076708392331112734321710563038064958&'
      WRITE (23,*) '005116246574857201376153524093387680806478583679300528971980699911741287605953&'
      WRITE (23,*) '586470409072882776356204822328609652193626414073064510894462672614932722760777&'
      WRITE (23,*) '026282940971996547002981021066598540204657328890627323543486231798263301056279&'
      WRITE (23,*) '760442020972201453593211921881552072457634111027443671290307386065386485310478&'
      WRITE (23,*) '454272621574562273671112317781694901946451701347432652533982585429347879354032&'
      WRITE (23,*) '463295310439579931360566137726876710718118338252331369932772474471610416540169&'
      WRITE (23,*) '310964440986229165100924217852698831497086244996049353293820900598735378488439&'
      WRITE (23,*) '899783384488524590197592144011233172477294339689209038988429342344600707778602&'
      WRITE (23,*) '556437178763267172298820986593990064979660833084303671939010013639628059346739&'
      WRITE (23,*) '272978465227561504883291553386258385251111386974501172319971778784306412718304&'
      WRITE (23,*) '230787346600468505744036205267034477875661284618566981602429835530190062657617&'
      WRITE (23,*) '893775108955979920599340771432750175834353343936569251820817515538688752281365&'
      WRITE (23,*) '929818449311278473996565728782979536668069936342493572289772739010342601447410&'
      WRITE (23,*) '605869881100394943664149115737611732735493252485004222156935646767555446037179&'
      WRITE (23,*) '373991908144049565022397821137104979124265281823939797233480023155812714387433&'
      WRITE (23,*) '437826939263033542364579238984243702882095160974720858902610398165043527382504&'
      WRITE (23,*) '889251011580419326408433569515330479577868933934530839955319715487156792902032&'
      WRITE (23,*) '727827293149986284232674408471423750899345879196065208641381382844625962376385&'
      WRITE (23,*) '752143462156157933657823317104764641146293741217233188594728419208034732224497&'
      WRITE (23,*) '421993053241476528704532337549446666452608229114250349795533318220065785532565&'
      WRITE (23,*) '256527694171526134604625068839690254357377790395941005907854134711688101522738&'
      WRITE (23,*) '824636866811997748590427397824271548717154830014098962052712394958829156006583&'
      WRITE (23,*) '462520806675055782430003138113384918248006727452776587345042318343856595893072&'
      WRITE (23,*) '069732562143987525123320073483890058300447227493789494870095933185921225857327&'
      WRITE (23,*) '329675766745181903032127636682834450068051515366316500965308100641724033466058&'
      WRITE (23,*) '290389805801169265583310713452332139384444892498129915904293606000533408095266&'
      WRITE (23,*) '190866754656748758304161948165291305731945889512811333432111222074799417935739&'
      WRITE (23,*) '385488851464679484022730964201951991916116117060390689313842367462001811911616&'
      WRITE (23,*) '266446311007005740477803600615401560172008362974723299908843769559420604893084&'
      WRITE (23,*) '994925745245151086996742503864116092149332171508890993418165134672954779047797&'
      WRITE (23,*) '312441835554323643510641920417446706909852629948519064412047591663508776731974&'
      WRITE (23,*) '841960820068143355313950000464087561985935467236159204729106634348951401306411&'
      WRITE (23,*) '089639167320204271128561425637063556038660641315435901618367367232688368339120&'
      WRITE (23,*) '518979184004091948436755520893788815074949141183940417728248767438565621858793&'
      WRITE (23,*) '398967999203848819703258362622996432591662033512544045458219769464179291113592&'
      WRITE (23,*) '233963572704006491972837292830811303038219241655995992840619905791953065930198&'
      WRITE (23,*) '451432967153004897346036504514287830579831178703604189297190847901533849240206&'
      WRITE (23,*) '963009865645286581025787798620710513271123106992710378105963507136174698568760&'
      WRITE (23,*) '973095891316223328936134460762974086677137325108258817452822752959631891360763&'
      WRITE (23,*) '246161226023600250511930952768192570938782215656186128652581923410875888342754&'
      WRITE (23,*) '710787070572506881728569362203429885569546346205841130036268366950812015033445&'
      WRITE (23,*) '356351181283027018159686895537196513488681945474782349756022398257454205963940&'
      WRITE (23,*) '527474063473790142381127638304278935320097767944530803011089968810039642343052&'
      WRITE (23,*) '117425689710418362522924368173065514474149452408427483475999015701613747782368&'
      WRITE (23,*) '150717588234938107837386424084208834296717080460171683052915949036453805021703&'
      WRITE (23,*) '586228221029608660518435161829099356452114209094758222582018707150214340986405&'
      WRITE (23,*) '858346559110073384159778185760749582013683181941295674200970942279694869022001&'
      WRITE (23,*) '275694331775471988873122804511185850830227961156564689940870796949270643149699&'
      WRITE (23,*) '171697198601818650704484660941765509857244159116494814297934660663655903570001&'
      WRITE (23,*) '473536588224825420044431337073377316980182026586711997977693529928500110947512&'
      WRITE (23,*) '272836905460247329893300239961308146089678150875160100412500245088878992293740&'
      WRITE (23,*) '444970692001831597638971355011297964793210525497580049428539268735436748722946&'
      WRITE (23,*) '232919867573432336642260524646785559467499011795630083127619155801355350643281&'
      WRITE (23,*) '383859696657316664413867041068332782978349335949092903300396465972009560462447&'
      WRITE (23,*) '577084913603971969239039566092185332474414254262710219526866175932012971323430&'
      WRITE (23,*) '701728455783859958561320705548991783415580299275905668753080447029777360449834&'
      WRITE (23,*) '557406396431951800958254601216174172705834270080087363780398539366668172639010&'
      WRITE (23,*) '202020347623612313245147784131540867852595201591460672397586315372949687271187&'
      WRITE (23,*) '947754733553550159351414923623879996199188352943468600106083884243935493314231&'
      WRITE (23,*) '458726966711561545813899843821512290729631910827515148964377351753976503811947&'
      WRITE (23,*) '968532680285836415796266159001114140366861978684916756741292793405832407111118&'
      WRITE (23,*) '958892472333799798985431451305105565223117195824793293716762028501652339484686&'
      WRITE (23,*) '176795741054180069311231602138548195118956816979287997166964118093697652549868&'
      WRITE (23,*) '915794062144110030599836468390535327611765574867690892273387735272328724762982&'
      WRITE (23,*) '195584290831726601694582880754550161280931351833110137764688196157795934574776&'
      WRITE (23,*) '472670519547735341825563448251799197878267887758206272824961259882012661112299&'
      WRITE (23,*) '409707312396884014289059163918229496098018109493398793061867969428125510987880&'
      WRITE (23,*) '430246379388793226040760522544153773667465348798096174626917130731544240269091&'
      WRITE (23,*) '763961212807453710657187058929920708608282076619428670173097313859268419535696&'
      WRITE (23,*) '160227171558128186070158143138245013185510360438488072510453261852981762917577&'
      WRITE (23,*) '852958849243105504939842781266735657083637868562868788223735589132576522987025'
      WRITE (23,*) ' '

      CLOSE(23)

      OPEN (23,FILE='TEMPFM')
      CALL FM_READ(23,M_D)
      CLOSE(23)

      MFM3 = ABS(M_A - M_D)
      CALL FM_ST2M(' 1.0E-20000 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF
      NCASE = 3248
      M_B = 67
      M_A = LOG(M_B)

      OPEN (23,FILE='TEMPFM')
      WRITE (23,*) '4.2046926193909660596700719963637227505669329032218953371377841307752685055280&'
      WRITE (23,*) '868966389141878210254845339621912646600141969872064833275363688318077549180423&'
      WRITE (23,*) '833135353639633338607736598023369194616957994910670921835088374205631569702104&'
      WRITE (23,*) '358914331157007226886464474373656176214845992009851946284677305918702829202891&'
      WRITE (23,*) '587981463071481407004769056385986018759955189605803163735275369520247911693958&'
      WRITE (23,*) '420203399565906858637138827152686132122287278775933821406297965541145433104617&'
      WRITE (23,*) '816637659618924286357945221874082953891331077189072883147228053928626243068463&'
      WRITE (23,*) '751150700981375033085587433224001356505707472275148023338666373339507366848258&'
      WRITE (23,*) '942635919412049541570833988069380683758495676003588550866448101409393872237756&'
      WRITE (23,*) '089931953775200664653415303256465584526040470958356690747210035981372337060744&'
      WRITE (23,*) '765060569578645670044475769213965913580599108582213924911903825908479988561460&'
      WRITE (23,*) '973058364674291254263018791247383461565120982798207553025489908566503658436736&'
      WRITE (23,*) '396751446252376955968623813035107349889603760884216395464490736003143092644676&'
      WRITE (23,*) '508050014056094108868521651310062230845534400430063486018564715503508834293386&'
      WRITE (23,*) '362013094386762027495938006197919206284878972702931666365420670775692022491671&'
      WRITE (23,*) '354687712217490877192095178492037569374977448697369349259912277046532873487142&'
      WRITE (23,*) '765496327501889220539490973199663499102902888726654831174204656205959944299574&'
      WRITE (23,*) '171742270091615739874596960764041766945296737563273546638983139703386801428369&'
      WRITE (23,*) '920013632454996068708249633308257998211143077845865065481727146846850960573604&'
      WRITE (23,*) '554019429985301561544559666204320929699260091316148043288810448211605079668853&'
      WRITE (23,*) '657736701700412997795450185346026506336936271030893204403113117318102498733604&'
      WRITE (23,*) '358844232314097626277683553367776737085732243645370035952309106168921184374302&'
      WRITE (23,*) '597063069279988452303053016746125222605275135852719318203101601939568855145004&'
      WRITE (23,*) '278216920238047489236326963620374836725833728006770703568480039515111973487716&'
      WRITE (23,*) '721805652875486777176279272443044649089656022613115920052228710004852331000732&'
      WRITE (23,*) '808537871951817585283392307171403785937309572441187692671508006296885419017599&'
      WRITE (23,*) '246279993035162587430078420893839214055664268663052218146045125362370494812544&'
      WRITE (23,*) '882100366940859088035352318798237185435723811165815170417436643309474388746781&'
      WRITE (23,*) '967113478959958118543159329105759896621380327297195736943783011683594508978931&'
      WRITE (23,*) '904152848776521219871774981152666371051810476619911346958584554695480200682990&'
      WRITE (23,*) '925349975127165939391044505361866832944198062600799468016261021866674288852979&'
      WRITE (23,*) '629238492698837436344184563830976952189291476093598295068180165981702652094614&'
      WRITE (23,*) '481115947654744086977436123804440330798540682382566383689445071055232814977000&'
      WRITE (23,*) '884926338941520326266647287630447144957050785346548064350993608044448450908086&'
      WRITE (23,*) '265114907409513271059612797228322252249035113641344463379009562590720580913525&'
      WRITE (23,*) '495434094633528344782782577384556067232204361522033145186541061811691818087390&'
      WRITE (23,*) '643869459486393332030360858237474075052416066006341016379286487950322077024836&'
      WRITE (23,*) '682174392755532647243853459338339492615206889464617500273835662570179790223699&'
      WRITE (23,*) '812651523732100690268192363527978532693949904911029496283744978688216599345306&'
      WRITE (23,*) '298018122418694771169167104260888890169821804846498873631292707417618091457211&'
      WRITE (23,*) '695897675539044308896377870390184994895283178320170313998683449486664809003757&'
      WRITE (23,*) '603457131986491117722459297670594893283212324126613825677627336645113049473188&'
      WRITE (23,*) '397342624576287124142091478319366172217821270867095442000963817897130415849032&'
      WRITE (23,*) '458413233445359582702270902651679013198596033842548844704399659809267717280882&'
      WRITE (23,*) '704277203930755818470018812235785980997621433829554741035480556426500055710461&'
      WRITE (23,*) '644739859897191603272454332963606474795032879659613050195724113518356280211494&'
      WRITE (23,*) '953300799688102496232334620757514645761239757039353218309154256029108546073693&'
      WRITE (23,*) '739140004313974080685296145717456372795171822356639700760630302002035711727444&'
      WRITE (23,*) '094211053757178216090499232244918305900940886955891270507721498344381980874984&'
      WRITE (23,*) '520831861111543583610154279901531107685572945243186968045743237506789820665111&'
      WRITE (23,*) '096077433183105874138291103722697542443786081716442089183756108631611970587637&'
      WRITE (23,*) '785890920273656328622165139439399150882356107114639799507209199763292426282061&'
      WRITE (23,*) '399146878941674003563203263544504810826757116320971125442269809744395656618178&'
      WRITE (23,*) '395239071387625724393927560185077897136133679707383066944167881846614065087638&'
      WRITE (23,*) '936193965454689339144883186188481028721038582013278615481157730354235410178143&'
      WRITE (23,*) '197731889918053086676187062782390673040535897695597897931898731354697060952917&'
      WRITE (23,*) '781554433906490374381153380652693419241234647021785680983422758594607923331145&'
      WRITE (23,*) '461093003532419397301566594999412220935084096301760246125853350987526608325585&'
      WRITE (23,*) '960516021539961590379011913359705497487528265416944281309112205436743702235283&'
      WRITE (23,*) '079110068007460115207351873099741453202446232045946749401366034287247709082130&'
      WRITE (23,*) '796442617696233924541122658557226098145838230384563543887063844164152385385984&'
      WRITE (23,*) '571361359766141242546634748202413025557310909656205734148932896800836231414906&'
      WRITE (23,*) '017108643284843300223010460605320412082212030649441492225163849631981305786767&'
      WRITE (23,*) '286108481084232133653901624679675796201653059958996120911851922288426088712742&'
      WRITE (23,*) '882046008568352438438185075536978248533100572835394146664210230104028380743021&'
      WRITE (23,*) '306390095117651177287543883921739244037922423532344677427815810367362391060314&'
      WRITE (23,*) '965932607379703425776557791230144358949836122431657452228383789078602351439547&'
      WRITE (23,*) '590746821547883226979490619390297198413532723673637582844658443517940411989722&'
      WRITE (23,*) '359971568904594174635827154249176388909663319400698224431381962659099698637433&'
      WRITE (23,*) '830349277718918647910775108880675338790796928062623641961130855754932620153205&'
      WRITE (23,*) '483047623374184685677677962702768417334215462164150467203744328795040589513224&'
      WRITE (23,*) '570051886006980307733035839210291239474878310292695192068374232646894905962286&'
      WRITE (23,*) '315273454160909253006299828452267416954763936032081790420848981112625859338617&'
      WRITE (23,*) '846744189353424099189759550742545864740710722945606478022581220237140611846781&'
      WRITE (23,*) '378310825627483373453893855335962034945669776103059804488292994369568739421037&'
      WRITE (23,*) '085296525186280238112454795740485779540543713452962021236051975717954720467543&'
      WRITE (23,*) '187411255716942394962782829143547116905728758366007214612842571932937685316208&'
      WRITE (23,*) '780929350103382415497786773141717647552280798677357156904022475216411612500128&'
      WRITE (23,*) '541907348080178369974075456081929800563016101577078048701705520504367951382878&'
      WRITE (23,*) '431464175744535313066162971524447715525930797458812085297703735563874421808143&'
      WRITE (23,*) '824231360578434026565886226942942833435718310670222245645672549359286510932615&'
      WRITE (23,*) '372676215657433381293441347104448604031995896780053742592507039400394523423854&'
      WRITE (23,*) '381556173259519120810345981548261177254685886661771469336387491020902794274855&'
      WRITE (23,*) '237638175722846040262868975750312534798635406604454676811030023032391268528899&'
      WRITE (23,*) '663550623710441474054368971434517900978482768875771355631930781177912033310071&'
      WRITE (23,*) '205611270673422775152990059935731309410821621307599215111934871390210271648344&'
      WRITE (23,*) '708485233650016455711363858978482898616336172408803080255034210740840550629197&'
      WRITE (23,*) '527685798763904495359905780470870651634407875318436783575929580487752967501823&'
      WRITE (23,*) '577006594751046655758223496917745986625405844520849013495455167597114618679286&'
      WRITE (23,*) '285378125913760397373568089498879552417485915991698643595876521992040264031505&'
      WRITE (23,*) '603085559059532409101854392341085558350322544005549440727138474594872870649225&'
      WRITE (23,*) '874774839687492883905180218529216090690806948649203479881104988415779617505933&'
      WRITE (23,*) '833800989073664122940415747349744733267553282291802424864218836781136985826302&'
      WRITE (23,*) '026034014944468033697376985704682713175989062675845402021225107523148010936597&'
      WRITE (23,*) '632214780669920581818227425796490964481601910740249363441336135598119367077641&'
      WRITE (23,*) '091253297343345307331543779045951132921694325076873025462543209628572503179163&'
      WRITE (23,*) '574110652808711141549657823494332077147313150255490897814044752827683511868816&'
      WRITE (23,*) '683211447902498441996530692033559756452545701020447718024213063675085118429116&'
      WRITE (23,*) '245843930755104890823794015171646982739401217233606697140937299720324945691490&'
      WRITE (23,*) '064003893143876414987548488752002801194973339519092159100466787856685682899286&'
      WRITE (23,*) '774588411752252779102418945348080721418597801927430470604961675562034850731257&'
      WRITE (23,*) '728384239582109055853643430359998182506783829145450839425876292412590362744811&'
      WRITE (23,*) '192891395966930178370500803545828025834465023713687505622292820555499623388119&'
      WRITE (23,*) '314094428695477750119309118059224062798078169045678480534567727768201167909097&'
      WRITE (23,*) '876958535951041609718065787972415763495153564936877281633081797892119096260896&'
      WRITE (23,*) '535145701699419099128640584918433607996627490472859643856818743788877170853666&'
      WRITE (23,*) '108356027406929685417576056615093930579519418329487609954263921962204722209881&'
      WRITE (23,*) '656554909243548450242482359374606359549899836842934079415704340950135155357860&'
      WRITE (23,*) '280138084248909780057904915059200447548595249019070848055913472772465218418262&'
      WRITE (23,*) '185375986224479509209858753173753223160257515837868310067768680113657883180858&'
      WRITE (23,*) '349962137677637916869201227994496456583380540391088974331062175747583098872402&'
      WRITE (23,*) '514628098295056056692908362688069521789931781333581876043311494143103656412486&'
      WRITE (23,*) '479241757378894980453009681235100451191942318723104973942912260727678921658295&'
      WRITE (23,*) '425744983004131005361570258121006302232838543982115039514523126899540958525676&'
      WRITE (23,*) '317851431535861868818829486082591466325529145089425743409012414691205939140563&'
      WRITE (23,*) '437659291754111073851127240482602609947038888686516781775297739141848460814905&'
      WRITE (23,*) '565376557241852551999082078526576888895627954445588473085994725269731985821952&'
      WRITE (23,*) '752288299705186551921564654871887520426375529055440938603480651236777191212228&'
      WRITE (23,*) '729891989006632697722676789283053458532909219346742862782215771179833489598309&'
      WRITE (23,*) '170001556227506676114596007094973546070689793732719898117883067718798209659646&'
      WRITE (23,*) '864892650000990526305491232105188430279594354499654585721743391684189104345788&'
      WRITE (23,*) '695257561533462430847468457536628811250227247032364751248775684018791383707996&'
      WRITE (23,*) '405594046743914431640510566976871253746299462738279316516238798072034943964561&'
      WRITE (23,*) '770416062056875633577506512079666649998298236242995346672471539892329035446522&'
      WRITE (23,*) '938401251080050397539653488664581012973580729124168470564792350969340707235135&'
      WRITE (23,*) '061666436213198193029640467097493652656254986417337357119555816021225510701047&'
      WRITE (23,*) '338370366912330746363386612030429920410782621744780661159829214216368118972968&'
      WRITE (23,*) '586005919608113285636476863415700518553956844732477506685896177990458982424045&'
      WRITE (23,*) '368482820608088263377153917163197544269621412198277096737670352555085993558965&'
      WRITE (23,*) '682733591239584118633353939216701105237783939083508786012430298565736516120590&'
      WRITE (23,*) '440249515520755202422188650527865548085284449296722718794524910029481305317740&'
      WRITE (23,*) '893916523032934961951821036672575749244782249139141843806736477339415707500102&'
      WRITE (23,*) '999555115422445236154494870794377652835285887062855191786898481080239600143358&'
      WRITE (23,*) '221730572471918006422396022939206630993656184665013474209346643100888375067613&'
      WRITE (23,*) '408299272105819674803020978320287176671271532478188021684394009308995197424920&'
      WRITE (23,*) '018961993897677381224895588813592877067239139741629154360307929091936801964503&'
      WRITE (23,*) '416381146521396827266263823470749284755390246368348077113514074305776068575084&'
      WRITE (23,*) '324363202443132738253957938712541144427995675297653783896617597449252883364314&'
      WRITE (23,*) '270900449255066620801611036028244386840297034802504861321224315545259486063130&'
      WRITE (23,*) '809854682246084182854485549539238059331109484053681261377375615674064970551733&'
      WRITE (23,*) '771934974200576586948108382447926970864534232669953757524878405015828197318333&'
      WRITE (23,*) '875871291283844958168013431351979970704768803851445855260017344413326224617282&'
      WRITE (23,*) '796133858012800917982533656137134916765682977771574772179552003596485659526341&'
      WRITE (23,*) '431312898634113264086452088864939018075785225185631533980393260324372539407308&'
      WRITE (23,*) '906234557448189898058962628734709380493229329402278230784662444361054659052727&'
      WRITE (23,*) '993225196378387197285560229036731041767334896255385547642652863350666789333192&'
      WRITE (23,*) '728267234259905602762950717427511958755752374386953436229761342337643552073646&'
      WRITE (23,*) '450319413244355557256441509628277275387050031562006515465711844736655969666010&'
      WRITE (23,*) '073478206209288328284118533263543363053124296538153195435958575565383486393193&'
      WRITE (23,*) '929928258498762138364572123643075553190916948393444493321731346732081338291374&'
      WRITE (23,*) '002168083086099384723927133175139794778980974929745458331340346253875193789286&'
      WRITE (23,*) '826461790086433443326316768138319140166799265613086616131862463660539167762139&'
      WRITE (23,*) '985527211047699136296130129222029755285179406375766320122166224268643836285722&'
      WRITE (23,*) '820517266826833705414062245782455907518332705545335710074222316187574346899507&'
      WRITE (23,*) '560454236573473141849599809965802580570906278518284896308694852300221648688606&'
      WRITE (23,*) '282569655190411140779593567449223685215814823714862770714191968878986987731427&'
      WRITE (23,*) '061806594278716748214207602223456215067619429196938836257859247367545762785284&'
      WRITE (23,*) '553974680261711563520204420595168336543233636489787302644804700151094605974620&'
      WRITE (23,*) '627637480004770657053343881302350192395322753974933734321289746139396911538639&'
      WRITE (23,*) '758527368448964422312733977119843776951899254936243722548995394845170596312300&'
      WRITE (23,*) '460164603065091355590648636500968012695421430648665682091808147191006018516888&'
      WRITE (23,*) '007170210581851643858994030624478251308058657532918085492724427561463464546637&'
      WRITE (23,*) '510458322849149231121111655970877052344330094135321754989367077541629921209014&'
      WRITE (23,*) '838624393677462635030080265104077286264700626370312751491105846784113962110937&'
      WRITE (23,*) '473451488901762576495056884971248864522407503158763070957412415695136402136626&'
      WRITE (23,*) '085038026244957495405848712909227176398433176584629214846709656917167919813078&'
      WRITE (23,*) '032180629359847109862555441332371713842638032257837342635153900502775954016623&'
      WRITE (23,*) '275872503106658601420786393015877918176857815542195817107009471654187596590497&'
      WRITE (23,*) '556023520238086604144876298656183087312061816670850332161290510502820995940577&'
      WRITE (23,*) '855192047954138416963188905324074471031672544103634439950244679729197724685279&'
      WRITE (23,*) '340407247084936830126620122033690156487834900881670839324759334522758503475674&'
      WRITE (23,*) '374506056321300678511647977950102258966743142762342818646025018086651800668294&'
      WRITE (23,*) '309805875085991157547449706494500801362305055376262766651076399908391526093872&'
      WRITE (23,*) '668275350593701516472809565911738967907271742613652240279294810324331673384018&'
      WRITE (23,*) '430551817848222998920874496571560430855218042995230221407846832920774076501881&'
      WRITE (23,*) '439436355660174316341344064349206716720899369374409248262034334863772028870871&'
      WRITE (23,*) '124073457130678539901409393160815790455840145147192872800532792560452584548379&'
      WRITE (23,*) '354025816739845772942443660741478775166660460113334673450727789366509592669241&'
      WRITE (23,*) '106120286619624583211735214046932366522262249532743303253000460702725568941672&'
      WRITE (23,*) '978755611932137881497078124195106147908344495728665918215514372063643085478525&'
      WRITE (23,*) '536151225535216673595768412631400483283517787868694131425862286352347244077958&'
      WRITE (23,*) '026744730659709295722949421356408225301744290481499717103067984116431312562548&'
      WRITE (23,*) '532233004572300419157948348406493410738130046369974635507451267368782256753548&'
      WRITE (23,*) '830838248560598227234078718708124605468435628123324158126125353276680730153092&'
      WRITE (23,*) '856958574118627481472240787181180646937539863138490012038068754757997415851085&'
      WRITE (23,*) '925036086100567034753573575322995349332837711214993223816162687796350349518999&'
      WRITE (23,*) '234844602002688179709238667132492177854195281420034640604613589582926157823999&'
      WRITE (23,*) '192939533463709138181601874933621515939780408637814467789832927480804680498512&'
      WRITE (23,*) '227247391738019960141101178874898104293942257061375850790904867712645382103190&'
      WRITE (23,*) '841381799367554628079732431972828723978993451090608031201155714040071639311271&'
      WRITE (23,*) '842821246239840175904722330854315719170954976102780842767116845258759403911298&'
      WRITE (23,*) '645470527056473383630249655697987702104815424378729589485112884630828135921023&'
      WRITE (23,*) '705600557651662016110405142253425878084735783057819061183716386282033602390958&'
      WRITE (23,*) '336853380754477331110433841888282272253948479989370514945217340738099710072413&'
      WRITE (23,*) '719913765477771627502687942895558987416597300030235527822097457431928028587193&'
      WRITE (23,*) '631102672911579037414653372093862120283071515060972658815414308702531526062969&'
      WRITE (23,*) '742521195532360193046591406921880865887051806056557797772794581406137991787139&'
      WRITE (23,*) '956978550530890803516856001980234397465635739325374090133054204439892388659246&'
      WRITE (23,*) '979058260332065621424260850451214951782153112704966243574660347614361472909788&'
      WRITE (23,*) '441887605258893925343019148582430294425602564765258572942930391218136320242807&'
      WRITE (23,*) '013835124561170935255295176132568987721115013464036821625004118680608957608039&'
      WRITE (23,*) '628421217630531772475799219037269131331824637615146439595831356495463084231252&'
      WRITE (23,*) '393951978669879650543783808935694749102929820724014406637576947674255101203905&'
      WRITE (23,*) '332549304801545678904266941727600233723012757399138452724986951355772210793664&'
      WRITE (23,*) '794535091910682866884895825917659296226147463771267715061628681303385512327693&'
      WRITE (23,*) '783184408373358934393889257116333659963518682051501864936737291960746561197602&'
      WRITE (23,*) '156521362469698606164386775811950224019906664334439826505455285682770575607598&'
      WRITE (23,*) '056519954509036446203487448891028615548649320290178125059812300063657130107531&'
      WRITE (23,*) '499126248478028029228776613647165032018899923668643498311603073205978158863004&'
      WRITE (23,*) '033218226685741591881471094400925245312599832754798886146391714667896675857480&'
      WRITE (23,*) '438952004196452571883254538556502170891272229146479614489731633608053814667400&'
      WRITE (23,*) '043383847929810630895585960166054170758059374281521718737593263605202117275984&'
      WRITE (23,*) '438436297004253619026647934543458558579249694086754028378151530261562397773678&'
      WRITE (23,*) '893801653506107494495928693210827955246962258318817000057940173454309463915823&'
      WRITE (23,*) '601712190125609083667042019024966092298313477915928716006904610929625928103706&'
      WRITE (23,*) '864110172306862168002782798106617886323238459484373982866702987924482582882181&'
      WRITE (23,*) '282709229918193246818487059129478224410350249336433677526065714199803650115892&'
      WRITE (23,*) '754219030897547718500024717934714321497292839839654330215600836986442424579427&'
      WRITE (23,*) '869822219480296137282808554130237487932697369182012651449035065223658010559950&'
      WRITE (23,*) '002358702480814086518435346823713334757540708338604084347061003654803275935906&'
      WRITE (23,*) '850305309483363462588147901241557175884894306320575440166849900089514465474088&'
      WRITE (23,*) '891776334880466300924905501573551344452329143072038581358277311877542628954790&'
      WRITE (23,*) '287977969056058152362028266998150135951275635394757629036730732556142251729266&'
      WRITE (23,*) '293740231754405405934771647080454600838654186883759429521053009591803828295117&'
      WRITE (23,*) '818477529191269463128596347932753639750744191432100411087158311854590814557646&'
      WRITE (23,*) '411429133064684467236135906885701598041116260365326853957323995090656811789988&'
      WRITE (23,*) '940586555467987472773093557241509568185047585253688741469386101110868980833513&'
      WRITE (23,*) '749149726555401975610279707276081935294748938120697822382876024831269921384270&'
      WRITE (23,*) '681413448460367032072724270368279769003980500992464916337895066121014456618493&'
      WRITE (23,*) '025933903663041470342144504671574000017564716087662750134127161218251173325389&'
      WRITE (23,*) '757250865559207489328920029133148889842210829855801898783449234155847609199114&'
      WRITE (23,*) '888777985633800311906630312521855797406664750532306300033369455510820660299280&'
      WRITE (23,*) '570253986791591933066540171682293622325608773503534685348103013114142809084661&'
      WRITE (23,*) '644052511941724596135629908212140090831946672454979862758382107408967939030227&'
      WRITE (23,*) '864181035378283953702690660807649359102126705797513056047279393444158242149701&'
      WRITE (23,*) '035094310286863918332524024461358747963005506173197844116218010744525164875849&'
      WRITE (23,*) '874834934751999182930715546627046436206883594322031010010017883489713969939925&'
      WRITE (23,*) '840108889665797057424297840699393009040599164609190292439355269184774533289628&'
      WRITE (23,*) '784265269372425952665453331398492927727547171214257820141972726873784536524647&'
      WRITE (23,*) '289315422938877001958016643993444136888077225192647145971270174335115994503746&'
      WRITE (23,*) '394224921184571769993125301167115471528802211666821179078166970503202574333943&'
      WRITE (23,*) '558308596079552406817715058216766631201541960333919024488739533792531900573773&'
      WRITE (23,*) '412737343507815693114569413408559767217397618912292076331376003144156268247155&'
      WRITE (23,*) '657326408731335241830759997415762189581210136512368369942294649097896660018920&'
      WRITE (23,*) '915478098797766047252484579057409890302128971855608319315709071820740990209727&'
      WRITE (23,*) '967740733059425832484513961280405079834545157924275290138100739323792817575757&'
      WRITE (23,*) '139431441222426598866002262245226904904653265490122918078571345637297901460157&'
      WRITE (23,*) '346405708559369186403655495182476230190285080657218154056128011973130774949092&'
      WRITE (23,*) '026595912706534397569832348146464344367334313343264907968090359221127661344009&'
      WRITE (23,*) '446055387381849533557779849000267741704468600048140068836153530505873426485117&'
      WRITE (23,*) '919748301498412224350555860150319819904641705596955299599597661253023814340739&'
      WRITE (23,*) '652669200240363631304500397695457570446122497216725861599065571114311829210653&'
      WRITE (23,*) '022731852524614365955774860298329031528227425374663255677801119172667202035135&'
      WRITE (23,*) '361902435585753442595726382231277316220201599490821050438025868343831537360967&'
      WRITE (23,*) '513718860516557344036402364443739380534732778877131270099031539920382803105766&'
      WRITE (23,*) '011893185228729835989897316656283172654633218841167516200323199771846515972455&'
      WRITE (23,*) '390478385224578123330531459882794695431178130398141406914562116603099959703515'
      WRITE (23,*) ' '

      CLOSE(23)

      OPEN (23,FILE='TEMPFM')
      CALL FM_READ(23,M_D)
      CLOSE(23)

      MFM3 = ABS(M_A - M_D)
      CALL FM_ST2M(' 1.0E-20000 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      NCASE = 3249
      WRITE (KWSAVE,"(/'     Check integer factorial:  5987!')")
      M_J = FACTORIAL(5987)

      OPEN (23,FILE='TEMPFM')
      WRITE (23,*) '208192927313311220490757655589384669106927918679356841667489099127409322369776&'
      WRITE (23,*) '108170811372236867865213629766457747241009858484835093483305960638769362583770&'
      WRITE (23,*) '566621358462398299769236882878587329421890825844184067509346016487626085365255&'
      WRITE (23,*) '044016439899064215740667576001348257025872905991614037588462949304094492309649&'
      WRITE (23,*) '405948159398591498533911222647046939906708776938239424442849762462382728144603&'
      WRITE (23,*) '579025920053807737725727466108906485780740262895358992271083878407161082909466&'
      WRITE (23,*) '716160433667377881675761096355367827155025621803637362285450061666280461690558&'
      WRITE (23,*) '784838065397595912239685411721111890180063912482320037891342793785520233815130&'
      WRITE (23,*) '631892709620858006215394415194541496895050993296013155373185552458973189991687&'
      WRITE (23,*) '008280548507017100664796358721466366011130053766927112514123097275847479937286&'
      WRITE (23,*) '925011673153522709653340306511424193210321033961125603941515829065167923041651&'
      WRITE (23,*) '937057433265633507223894477590860175603486192861910942723783181505133978973200&'
      WRITE (23,*) '322235882670239897466971518885641604474548881378362888880112859267618077384125&'
      WRITE (23,*) '462656269221172054412101098163794528749565956592099808283319190576489745057467&'
      WRITE (23,*) '415962342954034863650778977982804215216766196921576117906670310615337819245377&'
      WRITE (23,*) '401943497560509839370895309779974541456503092756464314200833363636708151694353&'
      WRITE (23,*) '412982511976329645136216217418774448716731496090568013705880744050677965361829&'
      WRITE (23,*) '331206139344319503458684159817234613375216511607316772124985043087500124534415&'
      WRITE (23,*) '896869707683467647751375158508916243738246357761648630167391893378795850503424&'
      WRITE (23,*) '942264888422101317824395474924569191547909863940955337266939098154327671576980&'
      WRITE (23,*) '264900910614597127235164109424401620748744414174878263175106971075403768218802&'
      WRITE (23,*) '569347749015340212317621061797901045839641033955233054731717326760158869423623&'
      WRITE (23,*) '945653352585371770362577107509774807838676722866760531902451883197843692431002&'
      WRITE (23,*) '935153306841999664957034061910095986811953900577244417051660599752038346361820&'
      WRITE (23,*) '269400417137380019280324706950416442262968792090546950481075361838203035846407&'
      WRITE (23,*) '188572419899367457729769762293304678298897434334131821848123239081167557055746&'
      WRITE (23,*) '965287231056700059818747936111255222257149960304044966265801398346707073898343&'
      WRITE (23,*) '714445331833013883065115258748250169930571346343018962152366571159508040583975&'
      WRITE (23,*) '136794965346324658932551750463223946252673228050622552781958953956139004747117&'
      WRITE (23,*) '744770404270965814330639826945462143313668399305587088259735871873465593543038&'
      WRITE (23,*) '689808892644114753221528550449697239528790714256370864263081132547745467248601&'
      WRITE (23,*) '206845118391520586742666781369542270664173849057414283483307625860416220718762&'
      WRITE (23,*) '758981481212186434400213534574208521163392222021082437997991241294081212431356&'
      WRITE (23,*) '242756280290842156565213853793225556261438142264726639578859677341156810274171&'
      WRITE (23,*) '763044908201640561388897266856794100865950512483552578847137010800298497013187&'
      WRITE (23,*) '884696205523159731239646790816136831481807362031080528644788073742956172188284&'
      WRITE (23,*) '844524533612973295133621090431555968624916171014366464759443644434542824949878&'
      WRITE (23,*) '908892207825910710836407643881294210905262999079354660879744082518417741335574&'
      WRITE (23,*) '314718181367744483447620506460547466056632998169591496029334449114097614836991&'
      WRITE (23,*) '609207738445013719616183984328596284817537375093143411160211461338403094559262&'
      WRITE (23,*) '807446086318549421738258837371491660334283370006659915917075294122843819581209&'
      WRITE (23,*) '295818501634280581382531637074756207121238072499978268020833760801707062510824&'
      WRITE (23,*) '635894810887800443203109022676894081492304122452090027595153388884158403063957&'
      WRITE (23,*) '353386843631546180726821578816801518043072096757883421704571840655466643186317&'
      WRITE (23,*) '993001299166259937666512290883374388217922888663023634509883671195384322014266&'
      WRITE (23,*) '167088406888440135096016410083842968007918295577776374042275912319740263586609&'
      WRITE (23,*) '266725737142370144503261572155972453463917766715786971709202479138474906809341&'
      WRITE (23,*) '968805516864533006984920262389185369762142245527383224937728761054214950799211&'
      WRITE (23,*) '299789139170154326071501265670006199980954086106822361677147116737763898511625&'
      WRITE (23,*) '882069838114438120553749877807451345428553969485393965445141804335204338751821&'
      WRITE (23,*) '190238984094180688978489640642787102284383303078177059545226204415327498446225&'
      WRITE (23,*) '494181435766355226542346880980039296758348042882686353542562034807232841665122&'
      WRITE (23,*) '225451886995208362755389154572256049687501635203974134205575750173093200217196&'
      WRITE (23,*) '650243486745773639840294671580443365851758109231436990783950789828851192147319&'
      WRITE (23,*) '548586388914913488916027299996382565290272474440744182787796912165867648640055&'
      WRITE (23,*) '016221143963827992277727938569957903796386675029850471752434094255353826039059&'
      WRITE (23,*) '059263683952798030083720018426632897384963076781966358138477621733289293915499&'
      WRITE (23,*) '793663940843209110772605298040769100139953221825201267997712593878444341034230&'
      WRITE (23,*) '782108764215129728814594410707715997251073258770153118660404024467673850656524&'
      WRITE (23,*) '931396911831689543070369892291992594892313892035024381908346888883821225414410&'
      WRITE (23,*) '029409794696181581449434685973318417453268545361612397953552388445022523300347&'
      WRITE (23,*) '774103966484959262454075548229068584652605582842099248147064588983267634627245&'
      WRITE (23,*) '285770580180612953258760488477010064385176048902372329354889599466306197271256&'
      WRITE (23,*) '180223256278028948777635106726380665274075287646529452422164323013480902121808&'
      WRITE (23,*) '355798563522821695903796630838879385914802157666845139198219756424185177351071&'
      WRITE (23,*) '617096465170949677165106164357040581915424752581930931947752216086669421070023&'
      WRITE (23,*) '848943521444988472728184582770485008532248737379661028818297498601083774792978&'
      WRITE (23,*) '915030896779132866337167134822864338869911817909343442560778166335675249398583&'
      WRITE (23,*) '844272693054776878150103097394993295014593259655490077735892683394474987018497&'
      WRITE (23,*) '676531540310024979475656409879334481384247615529461343131158000724526084292904&'
      WRITE (23,*) '027386963554505627263694842136234089023100708509890447222248539216409804957392&'
      WRITE (23,*) '359952942936090010802629959395700445733234300303835287590107562110204614195661&'
      WRITE (23,*) '425248380765903400113176531010312850566200123702779930191860573161664711816412&'
      WRITE (23,*) '623851434984083028500004775053023181068601119319603548578579267241487382865300&'
      WRITE (23,*) '450255145221470724137860689723124864359242105855939445240302049742659382064648&'
      WRITE (23,*) '248375070176018183142122437731842620349427061713562772213203565775179129686400&'
      WRITE (23,*) '029067646198860017637138820412761152297332667742536596877069727465532410723736&'
      WRITE (23,*) '806950050918396779914809089217325178877570429308013864748312694119048618661799&'
      WRITE (23,*) '334596387106342416356705235337582019571757823516151775042802318391336051676205&'
      WRITE (23,*) '194208974519567818697879987657755106894208982972774951964419868902418007323703&'
      WRITE (23,*) '267134934863482966629861359837148339860180905324314379186170457215003727252484&'
      WRITE (23,*) '892260363139549363285419557205680998139167614464448267969898245438356191937298&'
      WRITE (23,*) '141436491813821297295683305826502549459188508896304451136118193403565580265823&'
      WRITE (23,*) '379456775073868318324501856979270592461750915942996150055122458544630158771814&'
      WRITE (23,*) '752867398767804897250106306988849300342164576107063014780302962321443056181494&'
      WRITE (23,*) '836720652181743148116291818857111797064491306470701463422568015380992227593747&'
      WRITE (23,*) '679000925987269892644743708678534781715633469072503753329723125443162273618303&'
      WRITE (23,*) '550210086343784078009952477084539003288837236063477361521761951944008408758739&'
      WRITE (23,*) '112406047733291238727713872983373996388586527715053062292874426803209476680497&'
      WRITE (23,*) '557230597233778739093017959291536860696699487358478581263300634821556452463374&'
      WRITE (23,*) '744656695286316404389227545218831396621228091669954961719217073261758608637806&'
      WRITE (23,*) '735770497678164006659587609983020533725666881400466293902620022471389308072634&'
      WRITE (23,*) '098659230067286847675132563254272191155216519285770712432701535368669077893266&'
      WRITE (23,*) '729662136391274759651869406209943426082506856835746896634952316361972545450534&'
      WRITE (23,*) '900629738304718170690925667677932711622769945017682790655673950284251479766181&'
      WRITE (23,*) '758560026993193879569052337944109895003860571321488657525626007087585908465274&'
      WRITE (23,*) '412182260225171268890526394768334127219657180367615980845587557641971495024735&'
      WRITE (23,*) '364054342221695369614174666794864071364860932711084413137647487287952252084209&'
      WRITE (23,*) '695043320972023865392757824351062627044264295643368895957236150752687587820446&'
      WRITE (23,*) '738907077502525851500249118041108498985754352420143681331979805837593369294041&'
      WRITE (23,*) '142545209150329603007895732359317709420790603296119166443039070279587492778068&'
      WRITE (23,*) '724191513577838716454786707252089601339023438204997881445363588885656508642439&'
      WRITE (23,*) '910321214502822323745067813070915822916517442244501158291588682538315577086844&'
      WRITE (23,*) '909579502644102315301863086068818660805730548399833419181688603012856211567411&'
      WRITE (23,*) '039301750715543574856261850297084822621380376961104893143055114021824953212011&'
      WRITE (23,*) '040615778249527598642818469757481904469584157309247985579860585931302883253655&'
      WRITE (23,*) '115524313324160506640661576797738192770584425591210723255616625447872733496346&'
      WRITE (23,*) '123117976721896526233643956835406534792817856046871314353365552971507335065287&'
      WRITE (23,*) '908072484922807334906098980639704620818844966761265223160288317380174979363264&'
      WRITE (23,*) '249904258434101286821636787253133342504867260697919372393709160172351611970139&'
      WRITE (23,*) '321399572523058931541023846240146668056120881761344676379631607180410055206194&'
      WRITE (23,*) '205953143924613658067234140720076167337237565139618616923720948615248937979789&'
      WRITE (23,*) '572508674089314667968306871071818663071361531997755237067395632583852378017872&'
      WRITE (23,*) '435221973864985381455336983491460358611509852803254789556655944955876567196763&'
      WRITE (23,*) '724071401826406341230882278222607777506372187127171494736631488650126553027438&'
      WRITE (23,*) '085718807346079698111794608170712436948885747820743624286630803234139842471448&'
      WRITE (23,*) '248417722936518818759764315903062927617278459194740174115191889880338193532252&'
      WRITE (23,*) '749472358787706089602781401095122714004812463461082959818404399757865757226407&'
      WRITE (23,*) '202800702396623544027936261733836339748435935835576459430156078742675905845476&'
      WRITE (23,*) '041484452368827821067511980714605398318819802057156566403648444114407872252872&'
      WRITE (23,*) '468052839982246648364030273138153690649455331979876975977013363830174204205972&'
      WRITE (23,*) '339299300490205273488509600327366685538438652573646363370901707570429571376042&'
      WRITE (23,*) '290422394853820580626352335166881183829684447650720394963812096366548943326834&'
      WRITE (23,*) '743656792715316311841105329840732692653695457438268071098850577724741374522808&'
      WRITE (23,*) '062317600730862094565846214038590642215173028078227341939136227576580092420509&'
      WRITE (23,*) '012046175852107053104153903492016554861874486182989682269332320333284961551007&'
      WRITE (23,*) '187194740557463289643246100041791426733875402390792618280659447801501736306365&'
      WRITE (23,*) '757328074728488421670438860407045975183909355893747160045283889494065866123411&'
      WRITE (23,*) '417047068032384104951789107523103531744536374134060557018819202447292350682045&'
      WRITE (23,*) '927788615649205724980748062288462143957078190383373598914564258528979438388045&'
      WRITE (23,*) '558043154214592424081554489152460034571213609308288316117305185452774662158975&'
      WRITE (23,*) '681938551375252705412203149473295603974779962766806601659417895000859760513905&'
      WRITE (23,*) '175426335974434987213261164102088964887064942813275793035656462993644172367307&'
      WRITE (23,*) '944960203284375352979144359559619064302329684500766341698815792172946895973326&'
      WRITE (23,*) '549387814775379031810107421109722805620262502044288084799659453243903296252142&'
      WRITE (23,*) '880485054061011062824542847660117094902126224259693958528397939766285012735837&'
      WRITE (23,*) '124398434607192288199061176669047537087135679907368644424294634244529922131536&'
      WRITE (23,*) '039381564052393787223381343598410894688045388689015053054395938532739553502754&'
      WRITE (23,*) '305337791008943735999108784300413402148451468490151238021731862315253500747284&'
      WRITE (23,*) '606459432803345412667510681878208426181576299140508605228096307858914194564920&'
      WRITE (23,*) '471909133983476572012574716861424841070789085066727353302423397986649620600831&'
      WRITE (23,*) '757446216859102601436863945293022224643688860195200819510587819270220494769626&'
      WRITE (23,*) '182510946743119170100147203426503168249343255512216850955158419812077963086758&'
      WRITE (23,*) '825505786931776614817651738211964816733579826062267810955855592538222385265757&'
      WRITE (23,*) '052965521546477954556725687407123965495983931429387436130747597532142327585203&'
      WRITE (23,*) '521339125962885901198105763280948122227212479284175512324322782883002590507398&'
      WRITE (23,*) '404560339769395473512494961574723100979864892196967139231731211114163758589855&'
      WRITE (23,*) '322396028369285654796143357269786533849098307464814385324228841275142819249328&'
      WRITE (23,*) '164867648441855122628577489505762728811269316611789172074565422573612349276571&'
      WRITE (23,*) '390960938533517246228492344294326358887560064620674152696939142975534084918454&'
      WRITE (23,*) '173177885412667358449868488457127404758226997551426250602278738494749616504447&'
      WRITE (23,*) '585002741696926134416458075164693724461153718648552891289529271301459535616155&'
      WRITE (23,*) '591767781157116631077355482953211385336690547986182033565953540656130214777928&'
      WRITE (23,*) '803773376023096028821082362600354724851813134330193060698621244200556043615068&'
      WRITE (23,*) '008161086493387751759787941025241260291837243830192395722682577422995792068380&'
      WRITE (23,*) '357617361595047554819864131501562921430592619447679570784932997203491052260366&'
      WRITE (23,*) '035146665048569781852950190488602323925785410577892646672715845499445138218260&'
      WRITE (23,*) '172371476570506046954719870313447769244838998120537040847400283139459828059952&'
      WRITE (23,*) '773742400395556313344298622504803669515651791136039302631484026018247973489601&'
      WRITE (23,*) '452323835580501315756875300067303870692413903536661580599218136288299986284294&'
      WRITE (23,*) '088686610019564996922897878684679125984251416651658343988792061041321447592566&'
      WRITE (23,*) '391571198904009956773883141837821409284875557992762266837541808836025242044794&'
      WRITE (23,*) '827044219330555035103433822788437185736436241874146916860951053390718392586537&'
      WRITE (23,*) '971691750447750985563287364401713582873539410492508298713854643068205368853637&'
      WRITE (23,*) '704955060057052260518801271274843675339998201677973195037637780690641304924081&'
      WRITE (23,*) '398421518524036015518226349186024501497209562941629053700458342707355128560824&'
      WRITE (23,*) '039682464298099848650117160032934665894287630720026161276382227064304053488262&'
      WRITE (23,*) '016137686950807857233084194355722073787300677070873722419766316793792392559145&'
      WRITE (23,*) '104917571006340988847163668640790521031598759387627491027438956869251014468866&'
      WRITE (23,*) '291443164032436900408546054679339240635247398048867014737207760467295198418231&'
      WRITE (23,*) '055289741553189569992876152916101389604712375423312864489278749565522942941932&'
      WRITE (23,*) '635875642453703800010291995063252389373020573153719280420799680099670399216031&'
      WRITE (23,*) '282551241688878717952363501410948950529116940612760292077455985929502889108010&'
      WRITE (23,*) '503499587155720623695947325571934940008888268705644618317963131109137003964659&'
      WRITE (23,*) '702793560131996555828380288569909335595604865192125915430680146158406136438686&'
      WRITE (23,*) '660254953894007927055332270315957504822786601004158373336292891119596045608405&'
      WRITE (23,*) '885132206513874183645318099027683302579329695512435239347505008288016433308866&'
      WRITE (23,*) '346714195929701825553889512104983907316580093659503102613099560687578578146053&'
      WRITE (23,*) '290616072799435748578703728901599336719906652749173669051535652226085028262764&'
      WRITE (23,*) '727785631885164809110424500456758930244541041926548170167777797407538040592106&'
      WRITE (23,*) '408255027339046070942068102421444168825935357904196667920339116504622014098716&'
      WRITE (23,*) '120380671658541676668795780648852723157001748244107052106810339149294208258896&'
      WRITE (23,*) '088382022328777010071347307584350628238923866035689286090399316689689772484377&'
      WRITE (23,*) '939896433347018965491999188774630287691022942754022691115967165453682225334671&'
      WRITE (23,*) '135496682971260676669889521855359794222321636613356390327143221431118185563782&'
      WRITE (23,*) '235358684976441010455425956888871170327361473683062598299113454587405766971143&'
      WRITE (23,*) '317234972582078608162888515359197077088070367185279149882470676487835384714031&'
      WRITE (23,*) '610690684858225735518512682418941591773291696493986927771991886557923716057437&'
      WRITE (23,*) '584082224949671165510241365063498192405616599077697729331556998847656723821612&'
      WRITE (23,*) '283123439037914468664685694193015478333715079949590525237557370009353443081050&'
      WRITE (23,*) '828092410049807864108559988805873963874810161425579996535309676197726346686777&'
      WRITE (23,*) '573746911331752637190500223672476806575639392275510337818914350883366529438488&'
      WRITE (23,*) '558774549064916350425611748283373254702239152204070120652817061761239353528457&'
      WRITE (23,*) '531959915645578085330174067555760826511822417052420643224238523960484887691427&'
      WRITE (23,*) '686048133892432967581158107834833663985871887878689730971041901027828921604853&'
      WRITE (23,*) '256563107458936471030997125860530574421016947253724193889931541862883968779794&'
      WRITE (23,*) '536150728373390564038087588485795023097470249404617997487360324822193250147331&'
      WRITE (23,*) '044088356377489894865972441037491900966541735115636662281445721661254012327998&'
      WRITE (23,*) '963094481744053846426263937053642377811400884883098658414377966874293835459172&'
      WRITE (23,*) '979399074786070989584088828957105812428091120992423597313287643141833158804625&'
      WRITE (23,*) '961355353405890396509064524252975102157481482138953359985725371055306117237048&'
      WRITE (23,*) '477480823665445255940909413368351772555903036281048068572485228027426363979883&'
      WRITE (23,*) '902110900781414315684645752628020590956693815116522633267710307797937930678150&'
      WRITE (23,*) '423253751547230063340572219799576400152559053095188902296959293516765466415874&'
      WRITE (23,*) '619238741777011034859844010227144981884087205628777869434859859136842916127309&'
      WRITE (23,*) '312478538512520876960880251431308209750719442282160496768325996867199567763739&'
      WRITE (23,*) '467720921198844138254822673326620245393852332542488852987387191747767143360300&'
      WRITE (23,*) '840021238788572046552057649465186166911920194626459645008404891218527764781384&'
      WRITE (23,*) '154440959033373896009077053277739662780909418958818510143323346556447509444962&'
      WRITE (23,*) '189454904486344187902037881163258279516939840549173466560467560110490659849707&'
      WRITE (23,*) '844228347151128126024659067526064968589230462372723571442344335126464257851061&'
      WRITE (23,*) '866245891624273497049432045391237415685569384624185000862049537718594735147999&'
      WRITE (23,*) '704894476663334819401808136249865723379904323205825049683993882664417902084966&'
      WRITE (23,*) '454734196610719363692768227627187071131775625452676725503621557015031207780490&'
      WRITE (23,*) '806708795495870184358967349361593564010801394301442869521577605567363767591818&'
      WRITE (23,*) '782719395813170479087137384690415332745338301464130782933278424203413293267823&'
      WRITE (23,*) '876157045004489233684494901213602660351793685048274074490334789195564706076214&'
      WRITE (23,*) '281897768325298795601108797908431470374504701012307700995565404476704153449099&'
      WRITE (23,*) '737468003239471895931073717441747109210640925728276142761843372425473435588775&'
      WRITE (23,*) '920930732636539169788763176439506500984302856126082733943372002477613055485011&'
      WRITE (23,*) '152972839030592662652370765955466213555266461055619084940770749022488454449155&'
      WRITE (23,*) '443041996261076390898333456371277362856535477802097467614565761933699427829835&'
      WRITE (23,*) '655142055954314485969003873768990997640315550119236135039949223217252769345086&'
      WRITE (23,*) '177422435162121507699372372122770786645869198945063823270556038328557276006652&'
      WRITE (23,*) '195618485514435986509610069142418428547244410483168825254986510399407722981191&'
      WRITE (23,*) '936355019935074050916991747605764086835315188167615937800414090416073378941094&'
      WRITE (23,*) '462178611227812713016153886150663249618263480354946313686807662152631229009374&'
      WRITE (23,*) '845605774664985488052072077989293899737928361243041350868269990462039172726311&'
      WRITE (23,*) '778173197856502815266295512015784469409513841234775427724822438942611699285500&'
      WRITE (23,*) '140846444445805553063671642987605212078070337068206039588687491411686477996481&'
      WRITE (23,*) '868560525671434971392704362777819279792925442872119919434712744293627520235373&'
      WRITE (23,*) '833478687268302522818076272844342825468644595296674456722506331868680802514395&'
      WRITE (23,*) '761449604341589457883011925087737549991630260093565415463326499685728768517934&'
      WRITE (23,*) '593283957532712403735050761446326553653119010689274465168025975634933014661146&'
      WRITE (23,*) '055607413829968956901754256505857654096421365862001633379248734783736342723570&'
      WRITE (23,*) '208448980613969657212995401669307964639814460434639940889663435902018092189402&'
      WRITE (23,*) '071420332789255396467429858138979688359616017127529836458904426585863968489735&'
      WRITE (23,*) '970085327316527014701187563721074933760000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
      WRITE (23,*) '0000000000000000000000000000000000000000000000000'
      WRITE (23,*) ' '

      CLOSE(23)

      OPEN (23,FILE='TEMPFM')
      CALL IM_READ(23,M_K)
      CLOSE(23)

      IF (.NOT.(M_J == M_K)) THEN
          CALL ERRPRT_IM(' FACT ',M_J,'M_J',M_K,'M_K')
      ENDIF

      NCASE = 3250
      WRITE (KWSAVE,"(/'     Check Euler''s constant.')")
      CALL FM_EULER(M_A)

      OPEN (23,FILE='TEMPFM')
      WRITE (23,*) '0.5772156649015328606065120900824024310421593359399235988057672348848677267776&'
      WRITE (23,*) '646709369470632917467495146314472498070824809605040144865428362241739976449235&'
      WRITE (23,*) '362535003337429373377376739427925952582470949160087352039481656708532331517766&'
      WRITE (23,*) '115286211995015079847937450857057400299213547861466940296043254215190587755352&'
      WRITE (23,*) '673313992540129674205137541395491116851028079842348775872050384310939973613725&'
      WRITE (23,*) '530608893312676001724795378367592713515772261027349291394079843010341777177808&'
      WRITE (23,*) '815495706610750101619166334015227893586796549725203621287922655595366962817638&'
      WRITE (23,*) '879272680132431010476505963703947394957638906572967929601009015125195950922243&'
      WRITE (23,*) '501409349871228247949747195646976318506676129063811051824197444867836380861749&'
      WRITE (23,*) '455169892792301877391072945781554316005002182844096053772434203285478367015177&'
      WRITE (23,*) '394398700302370339518328690001558193988042707411542227819716523011073565833967&'
      WRITE (23,*) '348717650491941812300040654693142999297779569303100503086303418569803231083691&'
      WRITE (23,*) '640025892970890985486825777364288253954925873629596133298574739302373438847070&'
      WRITE (23,*) '370284412920166417850248733379080562754998434590761643167103146710722370021810&'
      WRITE (23,*) '745044418664759134803669025532458625442225345181387912434573501361297782278288&'
      WRITE (23,*) '148945909863846006293169471887149587525492366493520473243641097268276160877595&'
      WRITE (23,*) '088095126208404544477992299157248292516251278427659657083214610298214617951957&'
      WRITE (23,*) '959095922704208989627971255363217948873764210660607065982561990102880756125199&'
      WRITE (23,*) '137511678217643619057058440783573501580056077457934213144988500786415171615194&'
      WRITE (23,*) '565706170432450750081687052307890937046143066848179164968425491504967243121837&'
      WRITE (23,*) '838753564894950868454102340601622508515583867234944187880440940770106883795111&'
      WRITE (23,*) '307872023426395226920971608856908382511378712836820491178925944784861991185293&'
      WRITE (23,*) '910293099059255266917274468920443869711147174571574573203935209122316085086827&'
      WRITE (23,*) '558890109451681181016874975470969366671210206304827165895049327314860874940207&'
      WRITE (23,*) '006742590918248759621373842311442653135029230317517225722162832488381124589574&'
      WRITE (23,*) '386239870375766285513033143929995401853134141586212788648076110030152119657800&'
      WRITE (23,*) '681177737635016818389733896639868957932991456388644310370608078174489957958324&'
      WRITE (23,*) '579418962026049841043922507860460362527726022919682995860988339013787171422691&'
      WRITE (23,*) '788381952984456079160519727973604759102510995779133515791772251502549293246325&'
      WRITE (23,*) '028747677948421584050759929040185576459901862692677643726605711768133655908815&'
      WRITE (23,*) '548107470000623363725288949554636971433012007913085552639595497823023144039149&'
      WRITE (23,*) '740494746825947320846185246058776694882879530104063491722921858008706770690427&'
      WRITE (23,*) '926743284446968514971825678095841654491851457533196406331199373821573450874988&'
      WRITE (23,*) '325560888873528019019155089688554682592454445277281730573010806061770113637731&'
      WRITE (23,*) '824629246600812771621018677446849595142817901451119489342288344825307531187018&'
      WRITE (23,*) '609761224623176749775564124619838564014841235871772495542248201615176579940806&'
      WRITE (23,*) '296834242890572594739269638633838743805471319676429268372490760875073785283702&'
      WRITE (23,*) '304686503490512034227217436689792848629729088926789777032624623912261888765300&'
      WRITE (23,*) '577862743606094443603928097708133836934235508583941126709218734414512187803276&'
      WRITE (23,*) '150509478055466300586845563152454605315113252818891079231491311032344302450933&'
      WRITE (23,*) '450003076558648742229717700331784539150566940159988492916091140029486902088485&'
      WRITE (23,*) '381697009551566347055445221764035862939828658131238701325358800625686626926997&'
      WRITE (23,*) '767737730683226900916085104515002261071802554659284938949277595897540761559933&'
      WRITE (23,*) '782648241979506418681437881718508854080367996314239540091964388750078900000627&'
      WRITE (23,*) '997942809886372992591977765040409922037940427616817837156686530669398309165243&'
      WRITE (23,*) '227059553041766736640116792959012930537449718308004275848635083808042466735093&'
      WRITE (23,*) '559832324116969214860649892763624432958854873789701489713343538448002890466650&'
      WRITE (23,*) '902845376896223983048814062730540879591189670574938544324786914808533770264067&'
      WRITE (23,*) '758081275458731117636478787430739206642011251352727499617545053085582356683068&'
      WRITE (23,*) '322917676677041035231535032510124656386156706449847132695969330167866138333333&'
      WRITE (23,*) '441657900605867497103646895174569597181553764078377650184278345991842015995431&'
      WRITE (23,*) '449047725552306147670165993416390660912054005322158902091340802782251533852899&'
      WRITE (23,*) '511665452245869185993671220132150144801424230986254604488672569343148870491593&'
      WRITE (23,*) '044640189164502022405495386291847586293077889350643771596606909604681243702305&'
      WRITE (23,*) '465703160679992587166675247219409777980186362625633582526279422393254860132693&'
      WRITE (23,*) '530701388937436923842878938512764740856548650281563067740442203064403756826309&'
      WRITE (23,*) '102917514572234441050369317711452170888907446416048688701083862311426128441425&'
      WRITE (23,*) '960956370400619200579335034155242624026206465693543061258526583452192121497771&'
      WRITE (23,*) '878069586608516334922104836737994592594340379560002192785418379417760203365594&'
      WRITE (23,*) '673078879838084816314678241492354649148876683368407492893865281863048589820354&'
      WRITE (23,*) '818624383848175997635849075180791480634943916284705482200754945348986133827235&'
      WRITE (23,*) '730922190030740096800337666844932505567654937530318112516410552492384077645149&'
      WRITE (23,*) '842395762012781552322944928854557853820248918942441857095919558208100071578384&'
      WRITE (23,*) '039627479985817880888865716830699436060735990421068511427913169699596792300828&'
      WRITE (23,*) '988156097538338059109360341252998656790389568795673455083362907823862638563490&'
      WRITE (23,*) '747319275278740166557531190111543470018186256971261120126852923129937161403906&'
      WRITE (23,*) '965112224816615082353643982396620532633322248505191593682690715004315589871802&'
      WRITE (23,*) '783353845448309107249498057880961717996337167036554180041464667538719586948483&'
      WRITE (23,*) '331543583330641935929487420951478832347748481418149776871694413640056645156936&'
      WRITE (23,*) '116524161555734141935424721373067468333849054426626038372788217552709930958141&'
      WRITE (23,*) '026136979500786465876771608630804460749802801576962675913897794772214337515470&'
      WRITE (23,*) '829345879123898433055067223474969984942486706721502569273529585065869588997486&'
      WRITE (23,*) '535562186958043997125168976654169862653862891977542187721939605817001104236414&'
      WRITE (23,*) '158780810386172101557551923711160049880682291618097732421958328974869227183979&'
      WRITE (23,*) '190467716542668138893379296036815457939611339621922245430151580631743708405608&'
      WRITE (23,*) '536416031384982969518566952612822123716939368130321296561939718710207098007948&'
      WRITE (23,*) '833910197535104307441823448833331796978277332091143324514305086573457500687391&'
      WRITE (23,*) '475470777577559918467118308583660159437193718449039061770232536567977596744475&'
      WRITE (23,*) '747511584195746700997345002454428406585024508585646392791246119879093693072019&'
      WRITE (23,*) '804029303603738838430742162821201635386466226097198958436799430572030149638050&'
      WRITE (23,*) '832232365825557724534237187737439818333306454662906993311125973721950274646899&'
      WRITE (23,*) '065457155440303917835419756434315739034883866750542742161831050060550464223545&'
      WRITE (23,*) '708427393549359051762717479299472398908632970101905610107742690926475235740304&'
      WRITE (23,*) '630159243442464900834188630859320685522507790910195858895314328799817570981916&'
      WRITE (23,*) '829315940453005632543314488517357302698256937253469964013440871580108145287865&'
      WRITE (23,*) '790408663637945071108505104241797691911292615132010316363498086606948624407800&'
      WRITE (23,*) '668400671696221463718114777268341846646364242734053003138077349611998146861768&'
      WRITE (23,*) '585463120816316479893796426373835661893831371098328956490521148813402974238886&'
      WRITE (23,*) '863154313297876579912545424333856347200268129048994955042698088213026726358153&'
      WRITE (23,*) '248067538790323057421040330149788786752377860705468861472100992632942510887801&'
      WRITE (23,*) '970284117922402591091466584809257857192786282147667074087863519714256292427867&'
      WRITE (23,*) '028407703241437569931883243331559002433304769111009247979118006286202213707800&'
      WRITE (23,*) '621725732904735994398883139279927969397063567628116694054128859081982023838277&'
      WRITE (23,*) '035483496879734048888293016736770941584654400954862465146101353913496855912040&'
      WRITE (23,*) '236361872150992980651905861682815302875042754525860533196343259577747881343723&'
      WRITE (23,*) '939499124380614375449859068607518563142725525564259396701498041425981823785257&'
      WRITE (23,*) '682943639596562438852065654807103884546394453770191784571874101186223227802525&'
      WRITE (23,*) '194362657438242256093567692582387749116073775945140144703190224153559112506138&'
      WRITE (23,*) '178297421264982641618724606313340891926702359795802365841631755679233566210123&'
      WRITE (23,*) '133584549459059006998420067226025116774384736482438571540714626594564239112717&'
      WRITE (23,*) '078030637141692638644010057131095896063264963755295676936468941051795200061645&'
      WRITE (23,*) '202188435340473018243930514881984593076296404445687762416528716207276731860632&'
      WRITE (23,*) '540801428874571198657307471701886603687970364770854852871670003622928528837468&'
      WRITE (23,*) '246605881411754047446061676354303739923756596593696708792316774468569310838210&'
      WRITE (23,*) '783048315919643002144125970228906320317410114936648095290301171633453191792293&'
      WRITE (23,*) '924242877283787234956992923213609223494722645824375509451533552011761289751733&'
      WRITE (23,*) '951371782933287158609438662701179184155458726489825139255594379519731786744876&'
      WRITE (23,*) '992532617942338129994127939860264424519600605436818664670986594436593015437629&'
      WRITE (23,*) '148697959769499653352721002002096791043948254724411334224487005463765684086676&'
      WRITE (23,*) '215337362746159120547008629057169825735370523976123123841256434941178949861582&'
      WRITE (23,*) '859702097109703919635216812258224756271951938272828520914718237534365525402074&'
      WRITE (23,*) '620306673047695247009441381456178282666319613967359367257264603388494642489472&'
      WRITE (23,*) '448978481596715306153846712236987128231978476931105716623637326207595971180401&'
      WRITE (23,*) '514389623170601958570982381392466613527913695637655904861676205129740998314965&'
      WRITE (23,*) '597860253410129454399867288300624408440186181511750687088764671609799292017769&'
      WRITE (23,*) '624963301575829259618849485872002292248060628812177873383145882551293953651088&'
      WRITE (23,*) '191865120044923154983947731473578688973142047310945381464822632102331079439597&'
      WRITE (23,*) '462852354129575191063558792300195618131294612030157576340159785681751749842377&'
      WRITE (23,*) '882447375398247457599686770740854557432942402678193848220354096210606072192499&'
      WRITE (23,*) '082510485400318496319986322156908909761405310716511312932685349852440286448293&'
      WRITE (23,*) '470591608586995981988903959955918110764134466588145254256588153545028884739975&'
      WRITE (23,*) '324327809021522569521844145298650835512983980226238264974881811581525034599749&'
      WRITE (23,*) '915966400983201452007048035556858997309981503104192238508974537327612947171268&'
      WRITE (23,*) '165308867005472886577922467017826594827260972290347157414031669731070505078296&'
      WRITE (23,*) '108260728704291260823119741510147357847810107279711242797602848141151633886896&'
      WRITE (23,*) '907867175772593815247961237899990366617560358821813254675634483091487296266937&'
      WRITE (23,*) '219885027001882981730170249442140631726519713950622108276450718166391043668329&'
      WRITE (23,*) '566380730719454321125505362089678323031085171481149285889936287064887558438913&'
      WRITE (23,*) '004718684679858165552159013925603206137642715628011897109611400239130393406061&'
      WRITE (23,*) '778482110221716599265959682958890544989648574041220474973542564671840236504679&'
      WRITE (23,*) '058274859069504735553531183835808965288615889417441621988680423034924389581497&'
      WRITE (23,*) '367222749518112714534386974992432421386841484837577033108761767133199442634988&'
      WRITE (23,*) '067216670298371723057130497256381988443653998194797022327543291144443346325211&'
      WRITE (23,*) '479318846497359469448480951734770940726109149351051855043188851638018002426817&'
      WRITE (23,*) '631726458957788146589473162199135421797069639295912560383804858583156727254184&'
      WRITE (23,*) '614699660351900767011178230527999831318698072478216817338984691249055791086706&'
      WRITE (23,*) '543025629380810948236091118296066894973819763151051538493517552397192853567163&'
      WRITE (23,*) '929421336526958049103950351840242187193546181447795970030349815957972043067775&'
      WRITE (23,*) '949449017231423798597476267707800898011891852222929262329729280631476481001191&'
      WRITE (23,*) '709993531769730894226374020100709335066622785533772217649569429513342217056106&'
      WRITE (23,*) '818127569614044749582903928608574573882919365080522428612221275463635105136722&'
      WRITE (23,*) '125822455750771093554824186440818218680657808079971951770947419767773212482371&'
      WRITE (23,*) '462384395487937267559991170281970607563576664101281350099008705335620052336929&'
      WRITE (23,*) '605429509254541973523808772616447265372230756826505484509679771899200854891347&'
      WRITE (23,*) '407396416049412403555326815724626902383938518718802550684925766238748405876020&'
      WRITE (23,*) '851568226963759595051924724151133516339979157222400961087839275225882213091370&'
      WRITE (23,*) '903982536026810267141924576566175774597781406877480392728811583817563119477376&'
      WRITE (23,*) '560766005726467895297998458098623666372886042022108157462248075344471068266824&'
      WRITE (23,*) '531314678301397955654694465699247988477387250964676238903679415569294589007614&'
      WRITE (23,*) '520078868536367858812639918959157620043217199636790269882911241353800382628031&'
      WRITE (23,*) '504030039749014353600724971492214479643758821649852142913915384273409266056541&'
      WRITE (23,*) '107859009804754850156339629411006873227088580389209386660266980006473728247820&'
      WRITE (23,*) '412411924173296188763380556482765634362806022434826427529444866804709558214825&'
      WRITE (23,*) '898644301688129938538646305603236099773123960870297542270948386187482590661232&'
      WRITE (23,*) '366079611083208760971785785180155014858213269995803166919175521428507208991557&'
      WRITE (23,*) '973107600924829378301641820294128632633196317883190107426009661616474339415471&'
      WRITE (23,*) '030452836546064071934824026808748051413868316974125030020258370651319696179081&'
      WRITE (23,*) '369146457636041823285423301773883904534574963531243187897269622438904054033903&'
      WRITE (23,*) '930695288493580577776125643371595108950240899889318570203178001328019977794593&'
      WRITE (23,*) '112299552308849338750171861541860364176739567649056361598862243672529569480619&'
      WRITE (23,*) '860769068359724589424106760646984439397076406175503565002783992173562868396180&'
      WRITE (23,*) '408416369119211501155776948685790892247148784553154768257495726062378798014970&'
      WRITE (23,*) '674722354640498210776685941396850724508514339018888173055536931601670653909391&'
      WRITE (23,*) '147432099334808976720016884417834298884047712670483576935230068082754128375435&'
      WRITE (23,*) '298573553305079730500671205240128955776236713842811694763519207699037189430380&'
      WRITE (23,*) '421637143802026011066653481795022365479391717883965714656447437420668688735833&'
      WRITE (23,*) '199794916377430780910427849896848696069341450462136485237707090145221902946818&'
      WRITE (23,*) '311010595459003456379294809886301499826854423185500878779723024949554868090170&'
      WRITE (23,*) '869765483115615727622011473376443991501418567990740030037672560243741388601826&'
      WRITE (23,*) '281147310254695189478557853136583469555201409821287525639689263918589808251623&'
      WRITE (23,*) '672406477391949008501946281722380965739629579093560206866658498934080063406550&'
      WRITE (23,*) '151569717814639965693033183297518341636408758073086869433770130534755350707380&'
      WRITE (23,*) '020376787971498937491328559989959320285516202248353523430625004541942497456865&'
      WRITE (23,*) '778335976416571951895508961376615965441761125924395577874399029062767715978507&'
      WRITE (23,*) '442098881964333593223667348339760214243656682296563386296436643098365790502774&'
      WRITE (23,*) '285832937625151304198649989323990826721085251452196664337691929124568307902046&'
      WRITE (23,*) '470010977589386585361988541587230955225029384153983145045682582096197806356420&'
      WRITE (23,*) '181696020159418540250108519917441232044359433255386748664893693067885295996446&'
      WRITE (23,*) '411284996056526523608267398981987117548774096939187531617946083678898022608124&'
      WRITE (23,*) '243451095995683868000861799310710702963881404939122157400395481875578592231612&'
      WRITE (23,*) '347211869630335055311470859923358857870092118413269800255255090914405930908481&'
      WRITE (23,*) '794362042114949380046192562880723163672053591440491539434916323056090234305842&'
      WRITE (23,*) '614623231050272805681774732302381641835569442688787291214590816281953094501986&'
      WRITE (23,*) '409863370515188369936872272321282157944261169325925809723735145616982473133038&'
      WRITE (23,*) '449504125366090515653245082721603019799449338076471234957921342281621907187438&'
      WRITE (23,*) '982273420860284547721067207147698855269401438807380939380447076779481368156589&'
      WRITE (23,*) '979836824234592607151527012698013442837469806766707490882190684706656355638799&'
      WRITE (23,*) '359394664554943503374933857236685434578996655138620231507027267757724874814428&'
      WRITE (23,*) '656726218414717327824758420816863433272118986038485407155294280379121637347471&'
      WRITE (23,*) '936253784989052234713087189766479256257843028853236672296655170902166052301629&'
      WRITE (23,*) '604631841408378121554450028034243481767926749392803737422980180930297227420558&'
      WRITE (23,*) '605636539630767988666531730859657836792800653373388435733282136257948107214101&'
      WRITE (23,*) '357247663300376702160644195881497280925381097173048360551680297767033857116116&'
      WRITE (23,*) '357379272718506957483089854178653252203055843287505365707323768783953667065658&'
      WRITE (23,*) '437121236819406886880231979265992422636388891128946904020211309092652904440351&'
      WRITE (23,*) '671955889025854535659075663621170642493005981169439653653000144607137778634507&'
      WRITE (23,*) '024526291332390666480426744971657826737998617420258785900760957770282302951206&'
      WRITE (23,*) '237905849685457912549874939226631042431063861271724775671888206473836211757291&'
      WRITE (23,*) '386292342992075533360415148279052758645438463230548508211645489614370321105816&'
      WRITE (23,*) '670690716753966996934705195697280161875865631829671638983350351999223587550643&'
      WRITE (23,*) '365991933505457989978608901505691307864991295551560150591485570072085121222373&'
      WRITE (23,*) '236014829228808109284917467104680822796780585462274257119190623519018115588393&'
      WRITE (23,*) '345809208500598433454718414838467454498821236404336570772816563345556993128430&'
      WRITE (23,*) '168439806410112142410172335173914167718694538752598955737558076015062413471621&'
      WRITE (23,*) '879486188514037219800257284665274012966090357021714218690744586133555262852721&'
      WRITE (23,*) '004928008676550637747720269084028344949010122695083701756739211016793619482227&'
      WRITE (23,*) '306720274306421780338238561826407424166928738279267332182425122527934919765754&'
      WRITE (23,*) '711531551031634008053058046746537060153116304457968994220233747303997471922794&'
      WRITE (23,*) '003485294439798836062196756011376955344900290024024766289973138926494018209775&'
      WRITE (23,*) '659983756480868171771938495956267874842649927085898056023839576676355282259603&'
      WRITE (23,*) '730617278148818971888525879460802162212302900333066081809609261473615609593812&'
      WRITE (23,*) '495792099944332415715748435104309619443553104254164916150289163284962356216928&'
      WRITE (23,*) '143506284521178498824447386722841590379761915945316220998795682371803445674030&'
      WRITE (23,*) '205195447517707341107016209602431880273442501110931202686260491782619764142699&'
      WRITE (23,*) '123581121547165646328751248460328348231831183388165574952139985583172509595157&'
      WRITE (23,*) '114270972014718925357842172497868084030478532500889477825864371755409272827907&'
      WRITE (23,*) '786291461022255692919118741093445711640604764244783372979191609099671348650369&'
      WRITE (23,*) '891907164877141693948979715071347989764226742472488001601457843724122588168725&'
      WRITE (23,*) '662867207556056080845809124475575399539202446038358048033016635885864076236100&'
      WRITE (23,*) '234692493675465229634852537782175369431534440276447989299965780928807123536205&'
      WRITE (23,*) '907264232945997659234107216070073076305285418376991220386746561836015704671719&'
      WRITE (23,*) '210545042441773862426597277779250350012237790656702275487885514586457500655796&'
      WRITE (23,*) '627710051636942224073411689875106230992824775791335828597651448351261981775097&'
      WRITE (23,*) '704575491595470911890587001593033665622878593998189397253298307857455743323876&'
      WRITE (23,*) '578688278148434471425670317140801964359152062797845818216638904943399788731962&'
      WRITE (23,*) '333405088019153747402899737786376277973981946818654707520833775154607122766209&'
      WRITE (23,*) '612012482868387783933936440442782068506261914356541498500010734952891114529756&'
      WRITE (23,*) '858980757532959507852642061978983153186570253543099992874226189595508675364040&'
      WRITE (23,*) '599011288097144208657332837485797078071728398566307075896422598408685914316316&'
      WRITE (23,*) '830398891767220213151081541145684358224418564049489352457351707077957434714677&'
      WRITE (23,*) '391247158445765030667521484834867088194248376291849313419349270595714069404438&'
      WRITE (23,*) '486656004290010870496422475223966370378207910323813580916738394030225549027013&'
      WRITE (23,*) '603667925374100930351030294215350078423122193692113100735500517782125590180090&'
      WRITE (23,*) '189758948956829260500710914352846117016413348182531505768041478914156878481607&'
      WRITE (23,*) '411041638172952172486516562327433593364645281269048385080416744148816596892929&'
      WRITE (23,*) '875001176525062039199253202442499856370131521043205763859751596997775878901931&'
      WRITE (23,*) '926539550759620343899982502799237669772902105521254539340286474838417913238066&'
      WRITE (23,*) '059141093459934876325848519929228497193995693507177967072960203848722923747150&'
      WRITE (23,*) '140765786176771174408993400136927244191829685628245251748657902025770716583029&'
      WRITE (23,*) '853935066095540571663241126551724249990048205178938683547936966320669422958161&'
      WRITE (23,*) '050604030359040585662069577605945095219129191030265043557212878090927377825447&'
      WRITE (23,*) '774936343833336869500567523795175838116365257896893692420348314819899318157675&'
      WRITE (23,*) '946355987268370152972934539763387953396724843649699089955400295299155639991980&'
      WRITE (23,*) '112120122549591864509868990864535156475738679125209082331563857113259205813346&'
      WRITE (23,*) '296947083781078034213628498976780208971112282678269879210194898987156698008106&'
      WRITE (23,*) '644103527258123408056472309443396903625043297746420126313561341596502344991504&'
      WRITE (23,*) '774765705366125271942124563888861222355681773755420281393716401245093417134864&'
      WRITE (23,*) '892413424025308305228370342108957865874423495212421782595144749299841486632259&'
      WRITE (23,*) '803631830199223228460657603350268704051453889331851491821591049538380090344644&'
      WRITE (23,*) '366461890550030988563519195908340991033630840858917972058451512280615234348179&'
      WRITE (23,*) '186431604127199959142745423756327774842886188566400617380143873060743003207612&'
      WRITE (23,*) '908374637945275566050281666845830942463782581492320884105122265910609450782637&'
      WRITE (23,*) '708741962262301154596674127758538084202376673890516535970284295957833210637009&'
      WRITE (23,*) '259510159501234954389796041202325093036274908630148653907389582417952735284745&'
      WRITE (23,*) '357623120911584953750113473887485428833766873879809220392358890917600334360517&'
      WRITE (23,*) '341557950146917634324918300878337410688289348393687392767473010467425661695257&'
      WRITE (23,*) '652600452515616639412091874988944234340527682082201941031378698318477369742325'
      WRITE (23,*) ' '

      CLOSE(23)

      OPEN (23,FILE='TEMPFM')
      CALL FM_READ(23,M_D)
      CLOSE(23)

      MFM3 = ABS(M_A - M_D)
      CALL FM_ST2M(' 1.0E-20000 ',MFM4)
      IF (.NOT.(MFM3 <= MFM4)) THEN
          CALL PRTERR(KWSAVE)
      ENDIF

      KW = KWSAVE
      RETURN
      END SUBROUTINE TEST116

      END MODULE TEST_H


      PROGRAM TEST

      USE TEST_VARS
      USE TEST_A
      USE TEST_B
      USE TEST_C
      USE TEST_D
      USE TEST_E
      USE TEST_F
      USE TEST_G
      USE TEST_H
      IMPLICIT NONE

!             Write output to the standard FM output (unit KW, defined in subroutine FMSET),
!             and also to the file TestFM.out.

      KLOG = 18
      OPEN (KLOG,FILE='TestFM.out')
      KWSAVE = KW
      KW = KLOG

!             Set precision to give at least 50 significant digits and initialize the FM package.
!             This call also checks many of the initialization values used in module FMVALS
!             (file FMSAVE.f95).  Set KW = KLOG for this call so that any messages concerning these
!             values will appear in file TestFM.out.

      CALL FM_SET(50)
      KW = KWSAVE

!             Write output for testing error messages to the file FMERRMSG.OUT.

      OPEN (22,FILE='FMERRMSG.OUT')
      WRITE (22,*) ' '
      WRITE (22,*) ' This file is produced by the TestFM program while testing'
      WRITE (22,*) ' error messages and trace output options.'
      WRITE (22,*) ' '
      KW = 22
      CALL FPVARS
      KW = KWSAVE

      CALL CPU_TIME(TIME1)

!             Initialize some of the test variables.

      J2 = 131
      R2 = 241.21
      D2 = 391.61D0
      C2 = ( 411.11D0 , 421.21D0 )
      CD2 = ( 431.11D0 , 441.21D0 )
      CALL FM_ST2M('581.21',MFM1)
      CALL FM_ST2M('-572.42',MFM2)
      CALL IM_ST2M('661',MIM1)
      CALL IM_ST2M('-602',MIM2)
      CALL ZM_ST2M('731.51 + 711.41 i',MZM1)
      CALL ZM_ST2M('-762.12 - 792.42 i',MZM2)

!             NERROR is the number of errors found.

      NERROR = 0

!             Test input and output conversion.

      CALL TEST1

!             Test add and subtract.

      CALL TEST2

!             Test multiply, divide and square root.

      CALL TEST3

!             Test stored constants.

      CALL TEST4

!             Test exponentials.

      CALL TEST5

!             Test logarithms.

      CALL TEST6

!             Test trigonometric functions.

      CALL TEST7

!             Test inverse trigonometric functions.

      CALL TEST8

!             Test hyperbolic functions.

      CALL TEST9

!             Test integer input and output conversion.

      CALL TEST10

!             Test integer add and subtract.

      CALL TEST11

!             Test integer multiply and divide.

      CALL TEST12

!             Test conversions between FM and IM format.

      CALL TEST13

!             Test integer power and GCD functions.

      CALL TEST14

!             Test integer modular functions.

      CALL TEST15

!             Test complex input and output conversion.

      CALL TEST16

!             Test complex add and subtract.

      CALL TEST17

!             Test complex multiply, divide and square root.

      CALL TEST18

!             Test complex exponentials.

      CALL TEST19

!             Test complex logarithms.

      CALL TEST20

!             Test complex trigonometric functions.

      CALL TEST21

!             Test complex inverse trigonometric functions.

      CALL TEST22

!             Test complex hyperbolic functions.

      CALL TEST23

!             Test the derived type = interface.

      CALL TEST24

!             Test the derived type == interface.

      CALL TEST25

!             Test the derived type /= interface.

      CALL TEST26

!             Test the derived type > interface.

      CALL TEST27

!             Test the derived type >= interface.

      CALL TEST28

!             Test the derived type < interface.

      CALL TEST29

!             Test the derived type <= interface.

      CALL TEST30

!             Test the derived type + interface.

      CALL TEST31

!             Test the derived type - interface.

      CALL TEST32

!             Test the derived type * interface.

      CALL TEST33

!             Test the derived type / interface.

      CALL TEST34

!             Test the derived type ** interface.

      CALL TEST35

!             Test the derived type functions ABS, ..., CEILING interface.

      CALL TEST36

!             Test the derived type functions CMPLX, ..., EXPONENT interface.

      CALL TEST37

!             Test the derived type functions FLOOR, ..., MIN interface.

      CALL TEST38

!             Test the derived type functions MINEXPONENT, ..., RRSPACING interface.

      CALL TEST39

!             Test the derived type functions SCALE, ..., TINY interface.

      CALL TEST40

!             Test the derived type functions TO_FM, TO_IM, TO_ZM, ..., TO_DPZ interface.

      CALL TEST41

!             Test the derived type functions ADDI, ..., Z2M interface.

      CALL TEST42

!             Test Bernoulli numbers, Pochhammer's function, Euler's constant.

      CALL TEST43

!             Test Gamma, Factorial, Log(Gamma), Beta, Binomial.

      CALL TEST44

!             Test Incomplete Gamma, Incomplete Beta.

      CALL TEST45

!             Test Polygamma, Psi.

      CALL TEST46

!             Test the different rounding modes.

      CALL TEST47
      CALL TEST48
      CALL TEST49
      CALL TEST50
      CALL TEST51
      CALL TEST52

!             Test special cases and error cases.

      CALL TEST53

!             Test packed array routines and error messages.

      CALL TEST54
      CALL TEST55
      CALL TEST56
      CALL TEST57
      CALL TEST58
      CALL TEST59
      CALL TEST60
      CALL TEST61

!             Test derived-type array equal assignments.

      CALL TEST62
      CALL TEST63
      CALL TEST64
      CALL TEST65
      CALL TEST66
      CALL TEST67

!             Test derived-type array addition operations.

      CALL TEST68
      CALL TEST69
      CALL TEST70
      CALL TEST71
      CALL TEST72
      CALL TEST73
      CALL TEST74
      CALL TEST75
      CALL TEST76
      CALL TEST77
      CALL TEST78
      CALL TEST79

!             Test derived-type array subtraction operations.

      CALL TEST80
      CALL TEST81
      CALL TEST82
      CALL TEST83
      CALL TEST84
      CALL TEST85
      CALL TEST86
      CALL TEST87
      CALL TEST88
      CALL TEST89
      CALL TEST90
      CALL TEST91

!             Test derived-type array multiplication operations.

      CALL TEST92
      CALL TEST93
      CALL TEST94
      CALL TEST95
      CALL TEST96
      CALL TEST97
      CALL TEST98
      CALL TEST99
      CALL TEST100
      CALL TEST101
      CALL TEST102
      CALL TEST103

!             Test derived-type array division operations.

      CALL TEST104
      CALL TEST105
      CALL TEST106
      CALL TEST107
      CALL TEST108
      CALL TEST109
      CALL TEST110
      CALL TEST111
      CALL TEST112
      CALL TEST113
      CALL TEST114
      CALL TEST115

!             Test higher precision operations.

      CALL TEST116

!             End of tests.

      CALL CPU_TIME(TIME2)

      IF (NERROR == 0) THEN
          WRITE (KW, "(///1X,I5,' cases tested.  No errors were found.'/)" ) NCASE
          WRITE (KLOG, "(///1X,I5,' cases tested.  No errors were found.'/)" ) NCASE
      ELSE IF (NERROR == 1) THEN
          WRITE (KW, "(///1X,I5,' cases tested.  1 error was found.'/)" ) NCASE
          WRITE (KLOG, "(///1X,I5,' cases tested.  1 error was found.'/)" ) NCASE
      ELSE
          WRITE (KW, "(///1X,I5,' cases tested.',I4,' errors were found.'/)" ) NCASE,NERROR
          WRITE (KLOG, "(///1X,I5,' cases tested.',I4,' errors were found.'/)" ) NCASE,NERROR
      ENDIF

      IF (NERROR >= 1) THEN
          KWSAVE = KW
          KW = KLOG

!             Write some of the variables in module FMVALS.

          CALL FPVARS
          KW = KWSAVE
      ENDIF

      WRITE (KW,*) ' '
      WRITE (KW,"(F10.2,A)") TIME2-TIME1,' Seconds for TestFM.'
      WRITE (KW,*) ' '
      WRITE (KLOG,*) ' '
      WRITE (KLOG,"(F10.2,A)") TIME2-TIME1,' Seconds for TestFM.'
      WRITE (KLOG,*) ' '

      WRITE (KW,*)' End of run.'

      STOP
      END PROGRAM TEST


      SUBROUTINE ERRPRTFM(NROUT,M1,NAME1,M2,NAME2,M3,NAME3)

!  Print error messages for testing of real (FM) routines.

!  M1 is the value to be tested, as computed by the routine named NROUT.
!  M2 is the reference value, usually converted using FMST2M.
!  M3 is ABS(M1-M2), and ERRPRT is called if this is too big.
!  NAME1,NAME2,NAME3 are strings identifying which variables in the calling routine
!  correspond to M1,M2,M3.

      USE FMVALS
      USE FMZM
      USE TEST_VARS
      IMPLICIT NONE

      INTEGER :: M1,M2,M3

      CHARACTER(2) :: NAME1,NAME2,NAME3
      CHARACTER(6) :: NROUT

      NERROR = NERROR + 1
      WRITE (KW,  &
          "(//' Error in case',I5,'.  The routine',' being tested was ',A6)"  &
          ) NCASE,NROUT
      WRITE (KLOG,  &
          "(//' Error in case',I5,'.  The routine',' being tested was ',A6)"  &
          ) NCASE,NROUT

!              Temporarily change KW to KLOG so FMPRINT will write to the log file.

      KWSAVE = KW
      KW = KLOG
      WRITE (KLOG,"(1X,A,' =')") NAME1
      CALL FMPRINT(M1)
      WRITE (KLOG,"(1X,A,' =')") NAME2
      CALL FMPRINT(M2)
      WRITE (KLOG,"(1X,A,' =')") NAME3
      CALL FMPRINT(M3)
      KW = KWSAVE
      RETURN
      END SUBROUTINE ERRPRTFM

      SUBROUTINE ERRPRTIM(NROUT,M1,NAME1,M2,NAME2)

!  Print error messages for testing of integer (IM) routines.

!  M1 is the value to be tested, as computed by the routine named NROUT.
!  M2 is the reference value, usually converted using IMST2M.
!  NAME1,NAME2 are strings identifying which variables in the calling routine correspond to M1,M2.

      USE FMVALS
      USE FMZM
      USE TEST_VARS
      IMPLICIT NONE

      INTEGER :: M1,M2

      CHARACTER(2) :: NAME1,NAME2
      CHARACTER(6) :: NROUT

      NERROR = NERROR + 1
      WRITE (KW,  &
          "(//' Error in case',I5,'.  The routine',' being tested was ',A6)"  &
          ) NCASE,NROUT
      WRITE (KLOG,  &
          "(//' Error in case',I5,'.  The routine',' being tested was ',A6)"  &
          ) NCASE,NROUT

!              Temporarily change KW to KLOG so IMPRINT will write to the log file.

      KWSAVE = KW
      KW = KLOG
      WRITE (KLOG,"(1X,A,' =')") NAME1
      CALL IMPRINT(M1)
      WRITE (KLOG,"(1X,A,' =')") NAME2
      CALL IMPRINT(M2)
      KW = KWSAVE
      END SUBROUTINE ERRPRTIM

      SUBROUTINE ERRPRTZM(NROUT,M1,NAME1,M2,NAME2,M3,NAME3)

!  Print error messages.

!  M1 is the value to be tested, as computed by the routine named NROUT.
!  M2 is the reference value, usually converted using ZMST2M.
!  M3 is ABS(M1-M2), and ERRPRTZM is called if this is too big.
!  NAME1,NAME2,NAME3 are strings identifying which variables in the calling routine correspond
!  to M1,M2,M3.

      USE FMVALS
      USE FMZM
      USE TEST_VARS
      IMPLICIT NONE

      INTEGER :: M1(2),M2(2),M3(2)

      CHARACTER(2) :: NAME1,NAME2,NAME3
      CHARACTER(6) :: NROUT

      NERROR = NERROR + 1
      WRITE (KW,  &
          "(//' Error in case',I5,'.  The routine',' being tested was ',A6)"  &
          ) NCASE,NROUT
      WRITE (KLOG,  &
          "(//' Error in case',I5,'.  The routine',' being tested was ',A6)"  &
          ) NCASE,NROUT

!              Temporarily change KW to KLOG so ZMPRINT will write to the log file.

      KWSAVE = KW
      KW = KLOG
      WRITE (KLOG,"(1X,A,' =')") NAME1
      CALL ZMPRINT(M1)
      WRITE (KLOG,"(1X,A,' =')") NAME2
      CALL ZMPRINT(M2)
      WRITE (KLOG,"(1X,A,' =')") NAME3
      CALL ZMPRINT(M3)
      KW = KWSAVE
      END SUBROUTINE ERRPRTZM

      SUBROUTINE ERRPRT_FM(NROUT,M1,NAME1,M2,NAME2,M3,NAME3)

!  Print error messages for testing of TYPE (FM) interface routines.

!  M1 is the value to be tested, as computed by the routine named NROUT.
!  M2 is the reference value, usually converted using FMST2M.
!  M3 is ABS(M1-M2), and ERRPRT_FM is called if this is too big.
!  NAME1,NAME2,NAME3 are strings identifying which variables in the calling routine correspond
!  to M1,M2,M3.

      USE FMVALS
      USE FMZM
      USE TEST_VARS
      IMPLICIT NONE

      TYPE (FM) :: M1, M2, M3

      CHARACTER(3) :: NAME1,NAME2,NAME3
      CHARACTER(6) :: NROUT

      NERROR = NERROR + 1
      WRITE (KW,  &
         "(//' Error in case',I5,'.  The interface',' being tested was ',A6)"  &
         ) NCASE,NROUT
      WRITE (KLOG,  &
         "(//' Error in case',I5,'.  The interface',' being tested was ',A6)"  &
         ) NCASE,NROUT

!              Temporarily change KW to KLOG so FM_PRINT will write to the log file.

      KWSAVE = KW
      KW = KLOG
      WRITE (KLOG,"(1X,A,' =')") NAME1
      CALL FM_PRINT(M1)
      WRITE (KLOG,"(1X,A,' =')") NAME2
      CALL FM_PRINT(M2)
      WRITE (KLOG,"(1X,A,' =')") NAME3
      CALL FM_PRINT(M3)
      KW = KWSAVE
      END SUBROUTINE ERRPRT_FM

      SUBROUTINE ERRPRT_IM(NROUT,M1,NAME1,M2,NAME2)

!  Print error messages for testing of TYPE (IM) interface routines.

!  M1 is the value to be tested, as computed by the routine named NROUT.
!  M2 is the reference value, usually converted using IMST2M.
!  NAME1,NAME2 are strings identifying which variables in the calling routine correspond to M1,M2.

      USE FMVALS
      USE FMZM
      USE TEST_VARS
      IMPLICIT NONE

      TYPE (IM) :: M1, M2

      CHARACTER(3) :: NAME1,NAME2
      CHARACTER(6) :: NROUT

      NERROR = NERROR + 1
      WRITE (KW,  &
        "(//' Error in case',I5,'.  The interface',' being tested was ',A6)"  &
        ) NCASE,NROUT
      WRITE (KLOG,  &
        "(//' Error in case',I5,'.  The interface',' being tested was ',A6)"  &
        ) NCASE,NROUT

!              Temporarily change KW to KLOG so IM_PRINT will write to the log file.

      KWSAVE = KW
      KW = KLOG
      WRITE (KLOG,"(1X,A,' =')") NAME1
      CALL IM_PRINT(M1)
      WRITE (KLOG,"(1X,A,' =')") NAME2
      CALL IM_PRINT(M2)
      KW = KWSAVE
      END SUBROUTINE ERRPRT_IM

      SUBROUTINE ERRPRT_ZM(NROUT,M1,NAME1,M2,NAME2,M3,NAME3)

!  Print error messages for testing of TYPE (ZM) interface routines.

!  M1 is the value to be tested, as computed by the routine named NROUT.
!  M2 is the reference value, usually converted using ZMST2M.
!  M3 is ABS(M1-M2), and ERRPRT_ZM is called if this is too big.
!  NAME1,NAME2,NAME3 are strings identifying which variables in the calling routine correspond
!  to M1,M2,M3.

      USE FMVALS
      USE FMZM
      USE TEST_VARS
      IMPLICIT NONE

      TYPE (ZM) :: M1, M2, M3

      CHARACTER(3) :: NAME1,NAME2,NAME3
      CHARACTER(6) :: NROUT

      NERROR = NERROR + 1
      WRITE (KW,  &
        "(//' Error in case',I5,'.  The interface',' being tested was ',A6)"  &
        ) NCASE,NROUT
      WRITE (KLOG,  &
        "(//' Error in case',I5,'.  The interface',' being tested was ',A6)"  &
        ) NCASE,NROUT

!              Temporarily change KW to KLOG so ZM_PRINT will write to the log file.

      KWSAVE = KW
      KW = KLOG
      WRITE (KLOG,"(1X,A,' =')") NAME1
      CALL ZM_PRINT(M1)
      WRITE (KLOG,"(1X,A,' =')") NAME2
      CALL ZM_PRINT(M2)
      WRITE (KLOG,"(1X,A,' =')") NAME3
      CALL ZM_PRINT(M3)
      KW = KWSAVE
      END SUBROUTINE ERRPRT_ZM

      SUBROUTINE ERRPRT_STR(STRING1,STRING2)

!  Print error messages for testing of output formatting routines.

!  STRING1 is the output string, formatted by FM_FORM
!  STRING2 is the reference string to be compared to STRING1.

      USE FMVALS
      USE FMZM
      USE TEST_VARS
      IMPLICIT NONE
      CHARACTER(80) :: STRING1, STRING2

      NERROR = NERROR + 1
      WRITE (KW,*)   ' Error in case ',NCASE,' during input/output testing.'
      WRITE (KLOG,*) ' Error in case ',NCASE,' during input/output testing.'
      WRITE (KLOG,*) ' STRING1 = ',TRIM(STRING1)
      WRITE (KLOG,*) ' STRING2 = ',TRIM(STRING2)

      END SUBROUTINE ERRPRT_STR

      SUBROUTINE PRTERR(KW2)
      USE TEST_VARS
      IMPLICIT NONE
      INTEGER :: KW2

      WRITE (KW2,*) ' Error in case ',NCASE
      WRITE (KLOG,*) ' '
      WRITE (KLOG,*) ' Error in case ',NCASE
      NERROR = NERROR + 1
      END SUBROUTINE PRTERR
